github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-22 02:04:44 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/SYMBOL/DCMCP.esp_m
Paul Kimpel bab248fefc Commit DCMCP transcription as of 2012-09-26.
2012-09-26 21:29:41 +00:00

12592 lines
1.1 MiB
Raw Blame History

%B 5 7 0 0 M C P M A R K XVI.0.178 05/09/77%179-00001000
% 00002000
COMMENT: * TITLE: B5500/B5700 MARK XVI SYSTEM RELEASE * 00002010
* FILE ID: SYMBOL/MCP TAPE ID: SYMBOL1/FILE000 * 00002011
* THIS MATERIAL IS PROPRIETARY TO BURROUGHS CORPORATION * 00002012
* AND IS NOT TO BE REPRODUCED, USED, OR DISCLOSED * 00002013
* EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON * 00002014
* WRITTEN AUTHORIZATION OF THE PATENT DIVISION OF * 00002015
* BURROUGHS CORPORATION, DETROIT, MICHIGAN 48232 * 00002016
* * 00002017
* COPYRIGHT (C) 1965, 1971, 1972, 1973, 1974 * 00002018
* BURROUGHS CORPORATION * 00002019
* AA759915 AA320206 AA393180 AA332366 AA465080 * 00002020
* AA495655 AA496565 *; 00002021
$ SET OMIT = NOT(DEBUGGING) 00002100
BEGIN 00003000
DEFINE MIXMAX= 9#; COMMENT: MIXMAX MAY NOT BE LARGER THAN 29;00004000
DEFINE JOBNUMAX=40#; COMMENT: JOBNUMAX SHOULD BE ABOUT 00005000
2|MIXMAX+30; 00005001
DEFINE MARKLEVEL= % MARK LEVEL IN ALPHA 00005010
"XVI.0" 00005020
#, PATCHLEVEL= % PATCH RELEASE LEVEL IN ALPHA 00005030
"178" %179-00005040
#, LOCALEVEL= % LOCAL LEVEL IN ALPHA 00005050
" " 00005060
#; 00005070
DEFINE MCPTYPE = 63 #, 00005100
DCINTYPE = 63 #, 00005120
TSSINTYPE = 61 #; 00005140
COMMENT THE ESPOL COMPILER APPROPRIATELY TYPES THE MCP & 00005160
INTRINSICS FILE HEADERS SO THAT A VALIDITY CHECK MAY BE MADE 00005180
DURING INITIALIZATION AND AT CI AND CM TIME. HEADER[4].[36:6] 00005185
IS THE FIELD USED TO CONTAIN THE TYPE; 00005190
DEFINE ESAD = [1:15]#, 00005200
UNUM = [16:5]#, 00005210
BYBY(BYBY1,BYBY2)= 00005220
BEGIN STREAM(A:=TYPEDSPACE(10,SPOUTMSGAREAV) : );% %167-00005230
BEGIN DI:= A; DS:=BYBY2 LIT BYBY1; END; 00005240
PUNT(0); 00005250
END#; 00005260
DEFINE RESERVEDISKSIZE=2000#; 00005300
COMMENT TRACESIZE IS THE SIZE OF THE CORE AREA USED TO STORE TRACE 00005500
INFORMATION BEFORE IT IS WRITTEN ON DISK. 00005600
TRACAREASTART IS THE ABSOLUTE DISK ADDRESS OF THE TRACE 00005700
AREA ON DISK. 00005800
TRACAREASIZE IS THE SIZE (IN DISK SEGMENTS) OF THE TRACE 00005900
AREA ON DISK; 00005950
DEFINE TRACESIZE=30#,TRACAREASTART=10000#,TRACAREASIZE=480#; 00006000
DEFINE HANG=DO UNTIL FALSE#; 00006100
DEFINE LEFTARROW = "~"#; 00006150
$ SET OMIT = NOT(SAVERESULTS) 00006200
REAL JUNK=5;% 00007000
DEFINE PSEUDOMAX = 31 #, % MAX NO OF PSEUD-RDRS 0-ORIGIN 00007050
PSEUDOMAX1 = 32 #, % MAX NO OF PSEUD-RDRS 1-ORIGIN 00007055
PSEUDOMAXT = 63 #; % # ENTRIES IN TINU TABLE -2 00007060
COMMENT TO REDEFINE MAX NO. OF PSEUDO RDRS,SIZE AND INITIALIZATION 00007061
OF TINU[*] AT 00241900 MUST ALSO BE MODIFIED ACCORDINGLY; 00007062
COMMENT : PSEUDOMAX MUST BE }0 AND { 31 00007065
PSEUDOMAX1 MUST BE } 0 AND { 32 00007070
PSEUDOMAXT MUST BE } 31 AND { 63;% 00007075
COMMENT TO ADJUST THE PRIORITY, CORE ESTIMATE, AND STACK SIZE 00007200
OF LIBMAIN/DISK, SEE SEQUENCE NUMBER 45075470; 00007210
LABEL GOGOGO,NORMALERROR,P2BUSY,TIMER,EXTERNAL,INQUEST, 00008000
PROCSWIT,P2FAKE,KEYBOARDREQUEST,RETURN,COMINIT,MEMORYPARITY %WE 00009000
; 00010000
DEFINE GETUSERDISK(GETUSERDISK1)=PETUSERDISK(GETUSERDISK1,0)#;% 00012001
$ SET OMIT = NOT(DUMP OR DEBUGGING) 00012159
DEFINE DUMPNOW(DUMPNOW1) = 00012160
DUMPCORE(DUMPNOW1&(GETSPACE(22,0,0) + 3)[15:33:15])#;% 00012165
$ POP OMIT 00012166
INTEGER RRRMECH=@201;% 00013000
DEFINE SPACE(SPACE1) =(GETSPACE(SPACE1,0,0) + 2)#; 00013500
DEFINE MCP=M[1]#; %PRIVILEDGED USERCODE STORED IN M[1] 00013600
DEFINE % KEYIN TABLE DEFINE VALUES FOR "REPLY" 00013700
VAX = 01#, 00013710
VIL = 02#, 00013720
VUL = 03#, 00013730
VQT = 04#, 00013740
VOU = 05#, 00013750
VWY = 06#, 00013760
VRM = 12#, 00013770
VOK = 22#, 00013780
VFM = 23#, 00013790
VFR = 24#, 00013800
VOF = 25#, 00013810
VCC = 21#, 00013820
VIF = 32#; 00013830
DEFINE 00013850
$ SET OMIT = AUXMEM 00013860
SPACESTACKSIZE = 80#; 00013880
$ SET OMIT = NOT(AUXMEM) 00013900
SAVE INTEGER PROCEDURE GETSPACE(SIZE,TYPE,SAVEF);% 00014000
VALUE SIZE,TYPE,SAVEF;% 00015000
INTEGER SIZE,TYPE;% 00016000
BOOLEAN SAVEF; FORWARD;% 00017000
DEFINE %167-00017005
TYPEDSPACE(TYPEDSPACE1,TYPEDSPACE2) = 00017010
(GETSPACE(TYPEDSPACE1,TYPEDSPACE2,0)+2)# % 00017015
,ARRAYDESC(ARRAYDESC1,ARRAYDESC2) = 00017020
([M[GETSPACE(ARRAYDESC1,ARRAYDESC2,0)+2]] & ARRAYDESC1 [SIZE])# %00017025
,SAVEARRAYDESC(SAVEARRAYDESC1,SAVEARRAYDESC2) = 00017030
([M[GETSPACE(SAVEARRAYDESC1,SAVEARRAYDESC2,1)+2]] 00017035
& SAVEARRAYDESC1 [SIZE])# %00017040
; 00017045
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017100
%**********************************************************************%00017110
%* *%00017120
%* MEMORY AREA TYPES STORED IN 3:6 FIELD OF FIRST MEMORY *%00017130
%* LINK OF ALL MEMORY AREAS *%00017140
%* *%00017150
%**********************************************************************%00017160
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017170
DEFINE %167-00017180
UNKNOWNAREAV = 0# % %167-00017190
,CODEAREAV = 1# % %167-00017200
,DATAAREAV = 2# % %167-00017210
,IOBUFFERAREAV = 3# % %167-00017220
,ALGOLFIBAREAV = 4# % %167-00017230
,INQUIRYBUFFAREAV = 5# % %167-00017240
,COBOLFIBAREAV = 6# % %167-00017250
,TYPE7INTAREAV = 7# % %167-00017260
,DISKHEADERAREAV = 8# % %167-00017270
,MAINTBUFFAREAV = 9# % %167-00017280
,LBLEQNAREAV = 10# % %167-00017290
,SEGZEROAREAV = 11# % %167-00017300
,STACKAREAV = 12# % %167-00017310
,TYPE13INTAREAV = 13# % %167-00017320
,SCRATCHDIRAREAV = 14# % %167-00017330
,OPSETAREAV = 15# % %167-00017340
,DIRTOPAREAV = 16# % %167-00017350
,SPOUTMSGAREAV = 17# % %167-00017360
,UVROWAREAV = 18# % %167-00017370
,JARROWAREAV = 19# % %167-00017380
,CIDROWAREAV = 20# % %167-00017390
,INQINPUTAREAV = 21# % %167-00017400
,INTARRAYAREAV = 22# % %167-00017410
,RJEINPUTAREAV = 23# % %167-00017420
,DCQUEUEAREAV = 24# % %167-00017430
,DALOCROWAREAV = 25# % %167-00017440
,SHEETAREAV = 26# % %167-00017450
,STAWORDAREAV = 27# % %167-00017460
,KEYINBUFAREAV = 28# % %167-00017470
,FSAREAV = 29# % %167-00017480
,DC19QUEUEAREAV = 30# % %167-00017490
,AVTABLEAREAV = 31# % %167-00017500
,TRACETABLEAREAV = 32# % %167-00017510
,SEGDICTAREAV = 33# % %167-00017520
,STACKPRTAREAV = 34# % %167-00017530
,MCPTABLEAREAV = 35# % %167-00017540
,IRSTACKAREAV = 36# % %167-00017550
,FPBAREAV = 37# % %167-00017560
,CONTROLCARDAREAV = 38# % %167-00017562
,LABELAREAV = 39# % %167-00017564
,MDUMPAREAV = 40# % %167-00017566
,ESPDISKAREAV = 41# % %167-00017568
,LOGAREAV = 42# % %167-00017570
,CANDEINPUTAREAV = 43# % TSS MCP ONLY %167-00017572
,OBJOBINPUTAREAV = 44# % TSS MCP ONLY %167-00017574
,TYPE45 = 45# % %167-00017576
,TYPE46 = 46# % %167-00017578
,TYPE47 = 47# % %167-00017580
,TYPE48 = 48# % %167-00017582
; %167-00017600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017700
%**********************************************************************%00017710
%* *%00017720
%* M E M O R Y L I N K S *%00017730
%* *%00017740
%**********************************************************************%00017750
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00017760
% %167-00017762
% FIELDS OF MEMORY LINK 0 OF ALL AREAS %167-00017764
% %167-00017766
FIELD %167-00017770
AREAAVAILF = 01:01 % = 0 FOR IN-USE AREA, = 1 FOR AVAIL. AREA 00017780
,AREASAVEF = 02:01 % = 1 FOR IN-USE SAVE AREA, = 0 FOR OLAY AREA00017790
,AREATYPEF = 03:06 % TYPE OF AREA (SEE ABOVE) %167-00017800
,AREAMIXF = 09:06 % MIX INDEX OF OWNER OF AREA %167-00017810
,AREABACKLINKF = 18:15 % ADDRESS OF PREVIOUS AREA %167-00017820
,AREAFWDLINKF = 33:15 % ADDRESS OF NEXT AREA %167-00017830
; %167-00017840
SAVE REAL PROCEDURE WAITIO(IOD,MASK,U);% 00018000
VALUE IOD,MASK,U; REAL IOD,MASK,U; FORWARD;% 00019000
SAVE PROCEDURE DISKWAIT(CORE,SIZE,DISK); 00019100
VALUE CORE,SIZE,DISK; 00019200
REAL CORE,SIZE,DISK; 00019300
FORWARD; 00019400
PROCEDURE ERRORFIXER(TYPE); VALUE TYPE; REAL TYPE; FORWARD; 00019500
SAVE PROCEDURE SNOOZE(PRYR,ADDRESS,MASK); VALUE PRYR,ADDRESS,MASK; 00020000
REAL PRYR; NAME ADDRESS; ARRAY MASK[*]; FORWARD; 00021000
DEFINE SLEEP(SLEEP1,SLEEP2)=SNOOZE(PRYOR[P1MIX],SLEEP1,SLEEP2)#; 00021500
ARRAY PRYOR[*]; 00021600
REAL P1MIX,P2MIX; % SEE 00105000 00021700
ARRAY SLATE[*];% 00022000
REAL NSLATE,LSLATE;% 00023000
DEFINE SLATESIZE=16#,SLATEND=SLATESIZE-1#;%SIZE MUST BE TWO POWER 00023100
REAL NT1=@160,NT2=@161,NT3=@162,NT4=@163,NT5=@164,NT6=@165,NT7=@166; 00024000
REAL CLOCK = @170; % CLOCK.[9:33] CONTAINS THE NUMBER OF TIME INTERVAL 00024005
% INTERRUPTS PROCESSED SINCE HALT LOAD. CLOCK.[42:6] 00024006
% ALWAYS EQUALS ZERO. %156-00024007
COMMENT NT1 THRU NT7 ARE USED BY THE MCP FOR TEMPORARY STORAGE. 00024010
ALL PROCESSES THAT USE THESE VARIABLES ASSUME THAT IF CONTROL 00024020
IS LOST. THERI CONTENT MAY HAVE BEEN CHANGED BY THE TIME 00024030
THAT CONTROL IS REGAINED. 00024040
END COMMENT; 00024050
ARRAY TSKA = NT3[*]; 00024060
REAL MCPBASE; 00024100
COMMENT MCPBASE CONTAINS THE DISK ADDRESS (OCTAL) OF THE BEGINNING 00024200
OF THE MCP THAT IS CURRENTLY IN USE. THIS ADDRESS IS PASSED TO 00024210
THE MCP BY THE LOADER ROUTINE AT EACH HALT/LOAD IN M[0].[18:30].00024220
WHEN THE ESPBIT ROUTINE IS CALCULATING THE DISK ADDRESS 00024230
OF AN MCP SEGMENT, IT ADDS MCPBASE TO THE ADDRESS THAT 00024240
IS CONTAINED IN THE PRT CELL FOR THAT SEGMENT. 00024250
END COMMENT; 00024260
LABEL NOTHINGTODO,INITIATE,START,STACKOVERFLOW,IOBUSY; 00024270
$ SET OMIT = NOT(AUXMEM OR MONITOR) 00024299
$ SET OMIT = NOT MONITOR 00024590
DEFINE MCPNAMESEG = (DIRECTORYTOP-7)#; 00024610
COMMENT MCPNAMESEG CURRENTLY CONTAINS THE FOLLOWING: 00024620
WORD[ 0]-WORD[15] - FILE IDS OF THE AUXDATA FILES FOR MCP & INTRINCS. 00024630
WORD[16]-WORD[19] - CONTAIN THE WORD "AUXMEM " AS A MARKER. 00024640
WORD[20]-WORD[27] - FILE IDS OF THE MCP"S AT HALT/LOAD. 00024650
WORD[28] - USED BY DISKSQUASH FOR COMM. BETWEEN SHAREDISK SYSTEMS. 00024660
; 00024670
$ SET OMIT = NOT(NEWLOGGING) 00024999
$ SET OMIT = NEWLOGGING 00025299
DEFINE STARTLOG(STARTLOG1)= 00025300
PROCTIME[STARTLOG1]~(*P(DUP))-CLOCK-P(RTR)#, 00025400
STOPLOG(STOPLOG1,STOPLOG2)= 00025500
PROCTIME[STOPLOG1] !(*P(DUP))+CLOCK+P(RTR)#; 00025600
$ POP OMIT 00025601
SAVE PROCEDURE ESPBIT; COMMENT PRESENCE BIT ROUTNE FOR ESP SEGMENTS ;% 00025900
BEGIN INTEGER PRTLOC,SYLLABLE,LOC,SIZE;% 00026000
FIELD MAYBEWORKEDON = [7:1]; % %156-00027000
ARRAY MYSELF=ESPBIT[*];% 00028000
REAL RCW=+0,DISKREAD;% 00029000
LABEL MAKEPRESENT, TRYAGAIN; %156-00030000
$ SET OMIT = NOT(NEWLOGGING) 00030099
PRTLOC~(RCW INX 0)&RCW[30:10:2];% 00031000
STREAM(RLST~[SYLLABLE],CL~PRTLOC);% 00032000
BEGIN SI~CL; SI~SI-2; DI~RSLT; DI~DI+6; DS~2 CHR END;00033000
PRTLOC ~ IF SYLLABLE THEN NT4% 00034000
ELSE SYLLABLE.[36:10];% 00035000
SYLLABLE := @104; % THIS IS THE CODE WE WILL PASS TO 00035500
% GETSPACE THE FIRST TIME. IT REQUESTS00035510
% OVERLAY MEMORY FOR THE MCP AND THAT 00035520
% WE WANT TO BE RETURNED TO ON A NO 00035530
% MEM. %156-00035540
IF MEMORY[PRTLOC].MAYBEWORKEDON THEN% 00036000
MAKEPRESENT: BEGIN MEMORY[PRTLOC].MAYBEWORKEDON~FALSE;% 00037000
SIZE~MEMORY[PRTLOC].[8:10];% 00038000
% %156-00039000
% NOW WE WILL ATTEMPT TO GET SPACE FOR THIS MCP PROC. 00039005
% IF WE FAIL WE WILL WAIT FOR A SECOND AND THEN TRY 00039010
% AGAIN. THIS ENSURES THAT IF WE GET DS-ED WHILE %156-00039015
% SLEEPING WAITING FOR MEMORY WE WILL NOT LEAVE THE 00039020
% TOGGLE LOCKED UP FOR THIS PROCEDURE. %156-00039025
% %156-00039030
IF (LOC:=GETSPACE(SIZE,1,SYLLABLE))=0 THEN % NO MEM 00039035
BEGIN %156-00039040
MEMORY[PRTLOC].MAYBEWORKEDON := TRUE; % UNLOCK I00039045
SYLLABLE.[46:1] := TRUE; % DONT PRINT NO MEM 00039050
SLEEP([CLOCK],NOT CLOCK); % WAIT FOR ONE SECOND.00039055
GO TO TRYAGAIN; %156-00039060
END; %156-00039065
$ SET OMIT = NOT(AUXMEM) 00039099
DISKREAD~(LOC+1)&SIZE[8:38:10]&@14[21:42:6] %E00040000
&((SIZE+29) DIV 30)[27:42:6];% 00041000
STREAM(L:=LOC+1.N:=M[PRTLOC].[18:15]+MCPBASE,D:=0); 00042000
BEGIN SI~LOC N; DI~L; DS~8 DEC END;% 00043000
SYLLABLE~WAITIO(DISKREAD,0,18);% 00044000
$ SET OMIT = NOT(AUXMEM) 00044099
MEMORY[LOC]~MEMORY[LOC]&0[2:47:1]&0[9:42:6];% 00045000
MEMORY[LOC+1]~PRTLOC&SIZE[18:33:15];% 00046000
M[PRTLOC] := M[PRTLOC] & TRUE [MAYBEWORKEDON] %%156-00047000
&(LOC+2)[33:33:15];% 00048000
$ SET OMIT = NOT MONITOR 00048099
END ELSE% 00049000
TRYAGAIN: BEGIN SLEEP([M[PRTLOC]],0&TRUE [MAYBEWORKEDON]);% %156-00050000
IF (MEMORY[PRTLOC] INX 0)=(MYSELF INX 0) THEN% 00051000
GO TO MAKEPRESENT;% 00052000
END;% 00053000
$ SET OMIT = NOT(NEWLOGGING) 00053099
POLISH(0,RDF,0,XCH,FCX,STS);% 00054000
GO TO POLISH(MEMORY[PRTLOC]);% 00055000
GO TO START; % PLACE DESC.IN PRT FOR MCP TO AUXMEM TRANSFER 00055100
END ESPBIT;% 00056000
LABEL FINDIT; 00057100
REAL RESULT=12 ,RESULT2=13 ,RESULT3=14 ,RESULT4=15 ;% 00058000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00060000
%**********************************************************************%00060010
%* *%00060020
%* M I S C E L L A N E O U S F I E L D D E F I N I T I O N S *%00060030
%* *%00060040
%**********************************************************************%00060050
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00060060
%167-00060070
FIELD %167-00060080
FF = 18:15 % %167-00060090
,CF = 33:15 % %167-00060100
,CTF = FF % %167-00060110
,CTC = CF % %167-00060120
,MSFF = 16:01 % %167-00060130
; % %167-00060999
% % %167-00061000
% FIELDS OF AIT ENTRY %167-00061010
% %167-00061020
FIELD %167-00061030
FILEBIT = 01:01 % %167-00061040
,OWNBIT = 02:01 % %167-00061045
,DIMENSIONS = 03:05 % %167-00061050
,BLKCNTR = 08:10 % %167-00061060
,MOM = 18:15 % %167-00061070
; %167-00061999
% %167-00062000
% FIELDS OF DATA DESCRIPTOR %167-00062010
% %167-00062020
FIELD %167-00062030
% FLAGBITF = 00:00 % %167-00062040
% DATABITF = 01:01 % ALWAYS OFF FOR A DATA DESCRIPTOR %167-00062050
PBITF = 02:01 % ON IF DESCRIPTOR POINTS TO AREA OF CORE %167-00062060
,SIZE = 08:10 % SIZE OF ARRAY ROW IF ARRAY DESC. %167-00062070
% 0 FOR INDEXED DATA DESC, OR NAME DESC. %167-00062080
% ,MOMADDRESSF = 18:15 % ADDRESS OF MOTHER DESCRIPTOR. %167-00062090
% ,ADDRESSF =33:15 % IF PBIT IS ON THEN THIS FIELD CONTAINS AN%167-00062100
% ACTUAL CORE ADDRESS. IF THE PBIT IS OFF THEN 00062110
% IF THE VALUE OF THIS FIELD IS GREATER THAN 00062120
% OR EQUAL TO 512 THEN THE FIELD CONTAINS A%167-00062130
% DALOC ADDRESS WHICH CAN BE USED TO LOCATE THE 00062140
% DATA IN THE OVERLAY DISK AREA ASSIGNED TO THE 00062150
% THE PROGRAM. IF THE VALUE OF THE FIELD IS LESS00062160
% THAN 512 THEN THIS FIELD CONTAINS A CODE %167-00062170
% INDICATING THE STATUS OF THE AREA. %167-00062180
% 0 NEVER ACCESSED OVERLAY AREA. %167-00062190
% 1 NEVER ACCESSED SAVE AREA. %167-00062200
% 2 NEVER ACCESSED OVERALY AREA WHICH 00062210
% WHICH IS ASSIGNED TO AUXMEM. 00062220
% 5 INDICATES OVERLAY IS CURRENTLY IN 00062230
% PROCESS FOR THIS AREA. %167-00062240
% 6 INDICATES OLAY HAD IRRECOVERABLE 00062250
% ERROR WHEN OVERLAYING THIS AREA.00062260
% THE NEXT ACCESS TO THE AREA WILL00062270
% CAUSE THE PROGRAM TO BE TERMI- 00062280
% NATED. %167-00062290
; %167-00062999
% %167-00067000
% MISCELLANEOUS DEFINES %167-00067010
% %167-00067020
DEFINE %167-00067030
CURBLKCNTR = 16 # % %167-00067040
,AITINDEX = 6 # % %167-00067050
,FTF = 18:18:15 # % %167-00067060
,FTC = 33:18:15 # % %167-00067070
,DELTA = 11 # % %167-00067080
,TSX = 22 # % %167-00067090
,SFINTX = 27 # % %167-00067100
,INTRPTX = 28 # % %167-00067110
; %167-00067999
INTEGER AVAIL;% 00069000
COMMENT AVAIL CONTAINS THE ADDRESS OF THE STOPPER% 00070000
FOR AVAILABLE STORAGE LINKS ITS VALUE IS% 00071000
THE HIGHEST AVAILABLE ADDRESS-1;% 00072000
DEFINE MSTART = M[0].[CF]#; 00073000
COMMENT MSTART CONTAINS THE ADDRESS OF THE% 00074000
FIRST AREA OF STORAGE AFTER END OF% 00075000
ESP PROGRAM;% 00076000
DEFINE MEND = M[0].[FF]#; 00077000
COMMENT THIS POINTS TO LAST STORAGE LINK IN% 00078000
MEMORY;% 00079000
ARRAY TAR[*]; %CONTAINS TOGLE BITS SET BY EACH JOB 00079100
DEFINE LOCKTOG(LOCKTOG1)= BEGIN TOGLE:=TOGLE AND NOT LOCKTOG1; 00079200
TAR[P1MIX]:=TAR[P1MIX] OR LOCKTOG1; END#; 00079300
DEFINE UNLOCKTOG(UNLOCKTOG1)= BEGIN TOGLE:=TOGLE OR UNLOCKTOG1; 00079400
TAR[P1MIX]:=TAR[P1MIX] AND NOT UNLOCKTOG1; END#; 00079500
REAL TOGLE; 00080000
DEFINE HP2TOG = TOGLE.[47:1]#, HP2MASK = @1# 00080100
,STATUSBIT = TOGLE.[46:1]#, STATUSMASK = @2# 00080200
,SHEETFREE = TOGLE.[45:1]#, SHEETMASK = @4# 00080300
,STACKUSE = TOGLE.[44:1]#, STACKMASK = @10# 00080400
,STOREDY = TOGLE.[43:1]#, STOREMASK = @20# 00080500
,USERDISKREADY= TOGLE.[42:1]#, USERDISKMASK= @40# 00080600
,HOLDFREE = TOGLE.[41:1]#, HOLDMASK = @100# 00080700
,NSECONDREADY = TOGLE.[40:1]#, NSECONDMASK = @200# 00080800
,ABORTABLE = TOGLE.[39;1]#, ABORTMASK = @400# 00080900
,BUMPTUTIME = TOGLE.[38:1]#, BUMPTUMASK =@1000# 00080950
,KEYBOARDREADY = TOGLE.[37:1]#, KEYBOARDMASK =@2000# 00081000
,NOBACKTALK = TOGLE.[36:1]#, NOBACKTALKMASK=@4000# 00081100
,QTRDY = TOGLE.[35:1]#, QTRDYMASK =@10000# 00081200
,INTFREE = TOGLE.[34:1]#, FREEMASK =@20000# 00081300
,SPOEDNULLOG = TOGLE.[33:1]# 00081400
,REMOTELOGFREE = TOGLE.[32:1]#, REMOTELOGMASK = @100000# 00081500
,EGGSELECTSTOPPED = TOGLE.[31:1]# 00081600
,STARTOG = TOGLE.[30:1]# 00081610
,NINETEENNOTREADING=TOGLE.[29:1]#, NINETEENMASK=@1000000# 00081620
,SMWSTOPPED=TOGLE.[28:1]#, SMWSTOPPEDMASK=@2000000# 00081630
,DCWAITING=TOGLE.[27:1]# 00081640
,DCQPTSTOPPED=TOGLE.[26:1]# 00081650
,INQUPTSTOPPED=TOGLE.[25:1]# 00081660
,MCPFREE=TOGLE.[24:1]#, MCPMASK=@40000000# 00081670
% USED TO PROTECT DISK SEGMENT ZERO 00081675
,SCRATCHDIRECTORYREADY = TOGLE.[23:1]#, 00081680
SCRATCHDIRECTORYMASK = @100000000 00081690
% USED TO PROTECT THE SCRATCHDIRECTORY 00081695
,FINDINGADDRESS=TOGLE.[22:1]# 00081700
% SET TRUE WHENEVER THE INDEPENDENT RUNNING ROUTINE 00081705
% "FINDFREEADDRESS" IS STARTED SO THAT ONLY ONE COPY 00081706
% WILL BE RUN AT ONE TIME. 00081707
,CDFREE=TOGLE.[21:1]#,CDMASK=@400000000# 00081710
% SET TRUE WHEN CONTROL DECK QUEUE IS FREE 00081711
,NOMEM=TOGLE.[15:6]# %GETSPACES HANGING 00081950
,BREAKTOG=TOGLE.[14:1]# %BREAKOUT TOG 00081960
,BREAKMASK=@100000000000# 00081970
,SEPTICTANKING = TOGLE.[13:1]# 00081972
,DIRECTORYTOG = TOGLE.[12:1]# 00081974
,DIRECTORYMASK = @400000000000# 00081976
,NOMEMTOG = TOGLE.[11:1]# % ON IF NOMEM SINCE LAST NSECOND 00081980
,MEMNO = [9:3]# % 9:2 = COUNTER FOR NSECOND 00081982
00081999
STREAM PROCEDURE MOVE(N)"WORDS FROM"(HERE)"TO"(THERE);% 00082000
VALUE N,HERE,THERE;% 00083000
COMMENT WILL MOVE 0 TO 4095 WORDS;% 00084000
BEGIN LOCAL NDIV64;% 00085000
SI~LOC N; DI~LOC NDIV64; SI~SI+6; DI~DI+7; DS~1 CHR;00086000
SI~HERE; DI~THERE;% 00087000
NDIV64(DS~32 WDS; DS~32 WDS); DS~N WDS;% 00088000
END MOVE;% 00089000
$ PAGE 00089050
PROCEDURE STOPM(B); VALUE B; BOOLEAN B; FORWARD; 00089100
LABEL DIFFCOM; 00089200
SAVE PROCEDURE FORGETSPACE(LOC);% 00090000
VALUE LOC;% 00091000
REAL LOC;% 00092000
FORWARD;% 00093000
ARRAY BED[*]; % 4MIXMAX+4 00094000
COMMENT ENTRIES IN THE BED HAVE TWO WORDS.% 00095000
THE FIRST WORD HAS THE FOLLOWING FORMAT;% 00096000
0- 2 = 5% 00097000
3- 7 = MIXINDEX% 00098000
8-17 = 0% 00099000
18-32 = F REGISTER SETTING% 00100000
33-47 = ADDRESS OF WORD TO BE TESTED.% 00101000
THE SECOND WORD IS A MASK IF BIT 0 IF OFF.% 00102000
THE SECOND WORD IS AN ACCIDENTAL ENTRY DESCRIPTOR IF BIT 000103000
IS ON;% 00104000
COMMENT P1MIX,P2MIX NOW DECLARED AT 00021700; 00105000
COMMENT P1MIX IS THE MIX INDEX FOR THE JOB BEING CURRENTLY% 00106000
PROCESSED. P1MIX = 0 MEANS NO JOB IS CURRENTLY BEING% 00107000
PROCESSED. P2MIX IS THE MIX INDEX FOR THE JOB BEING% 00108000
CURRENTLY PROCESSED ON PROCESSOR 2. IF PROCESSOR IS IDLE 00109000
THEN P2MIX = 0. IF THERE IS NO PROCESSOR 2 THEN P2MIX=-1;00110000
REAL DATE=@167; 00111000
COMMENT DATE CONTAINS TODAYS DATE;% 00112000
REAL XCLOCK=@171; 00114000
REAL READY=@172; 00121000
COMMENT READY CONTAINS THE CONTENTS OF THE READY REGISTER ON% 00122000
THE LAST READ;% 00123000
COMMENT STATUSBIT IS FALSE IF THE STATUS ROUTINE IS RUNNING AND00125000
TRUE OTHERWISE. THIS PREVENTS TWO COPIES OF STATUS FROM% 00126000
RUNNING TOGETHER;% 00127000
ARRAY PRT[*,*];% 00128000
COMMENT PRT[1,*] CONTAINS A DATA DESCRIPTOR WITH PROPER SIZE% 00129000
FIELD POINTING AT PRT FOR JOB WITH MIX INDEX = 1;% 00130000
ARRAY PRTROW=PRT[*]; % MIXMAX+1% 00131000
COMMENT PRTROW IS DOPE VECTORS FOR PRT;% 00132000
ARRAY JAR[*,*];% 00133000
% JAR HOLDS INFO OF JOBS IN PROCESS (SEE DEFINES AT 20544000) 00134000
DEFINE 00134010
LIBMAINCODE=1#, LDCNTRLCODE=3#, PRNPBTCODE=5#, 00134020
SYSJOBF=[6:3]#, SSYSJOBF=[5:3]#; 00134030
% SEE 20556700 RE SYSJOBF (SYSTEM JOB FIELD) 00134040
% SEE 20515000 RE SSYSJOBF (SHEET SYSTEM JOB FIELD) 00134050
$ SET OMIT = NOT(WORKSET) 00134100
ARRAY STQUE[*]; % QUEUE FOR "STOPPED" JOBS, 16 LONG 00134110
DEFINE STQUEUEMAX = 15#; 00134115
ARRAY OLAYTIME[*]; % USED FOR STORAGE OF OLAY OVERHEAD TIME 00134120
PROCEDURE WORKSET(N); VALUE N; RAEL N; FORWARD; 00134125
ARRAY WKSETDATA[*]; 00134130
% ARRAY USED FOR STORAGE OF WORKSET INFORMATON 00134140
DEFINE WKSETCLOCK = WKSETDATA[0]#, 00134150
% TIME AT WHICH WORKSET ROUTINE HAS STARTED 00134160
% TO RUN 00134170
WKSETRUNNING = WKSETDATA[1].[47:1]#, 00134180
% TOGGLE TO INDICATE THAT WORKSET IS RUNNING 00134190
WKSETNOSELECT = WKSETDATA[1].[46:1]#, 00134200
% TOGGLE TO PREVENT SELECTRUN FROM PLACING 00134210
% ADDITIONAL JOBS IN THE MIX 00134220
WKSETMONITOR = WKSETDATA[1].[45:1]#, 00134230
% TOGGLE USED TO "MONITOR" WORKSETDATA 00134240
WKSETMAXOLAY = WKSETDATA[2]#, 00134250
% MAX. FRACTION OF PROCESS TIME TO COMPUTE 00134260
% MAXIMUM ALLOWABLE OLAY TIME 00134270
WKSETOLERANCE = WKSETDATA[3]#, 00134280
% FRACTION USED TO CMOPARE JOB STATISTICS 00134290
% (ALLOWABLE VARIANCE TO COMPUTE MAX.VALUES) 00134300
WKSETINSTRUCT = WKSETDATA[4]#, 00134310
% INSTRUCTIONS FOR COMPARING JOB STATISTICS 00134320
% FRACTION OF TOTAL SYSTEM CORE WHICH MUST 00134330
% BE KEPT AVAILABLE 00134340
WKSETCYCLETIME = WKSETDATA[5]#, 00134350
% CYCLE TIME (64THS OF A SECOND) FOR WHICH 00134360
% THE WORKSET ROUTINE IS RUN, QUEUED AT 00134370
% "TIME" IN THE OUTER BLOCK 00134380
WKSETSTOPJOBS = WKSETDATA[6]#, 00134390
% BIT INDEX (TWO(MIX)) FOR JOBS WHICH HAVE 00134400
% BEEN "ST-ED" BY THE WORKSET ROUTINE 00134410
STFIRST = WKSETDATA[7].[CF]#, 00134420
% INDEX TO FIRST ENTRY IN THE "STQUE" 00134430
STNEXT = WKSETDATA[7].[FF]#, 00134440
% INDEX T NEXT AVAILABLE SLOT IN "STQUE" 00134450
WKSETSWITCHTIME= WKSETDATA[8]#, 00134460
% TIME OF LAST "JOB" OR "EOJ" EVENT 00134470
WKSETDATASIZE = 9#; % SIZE OF THE WKSETDATA ARRAY 00134480
$ POP OMIT % WORKSET 00134490
ARRAY INTRNSC[*]; REAL INTSIZE;% RE-ENTRANT INTRINSICS ON USER DISK 00135000
ARRAY INTABLE[*,*], INTABLEROW=INTABLE[*];% 00135100
$ SET OMIT = NOT(AUXMEM) 00135199
ARRAY SHEET[*]; % 5% 00136000
ARRAY JARROW=JAR[*]; % MIXMAX+1% 00138000
DEFINE TABCNT[TABCNT1] = JARROW[TABCNT1].[FF]#; 00138100
COMMENT TABCNT IS THE NUMBER OF PROCESSES WHICH HAVE CHECKED 00138110
JARROW AND ARE CURRENTLY ACCESSING MIX TABLES. IT ASSURES 00138120
THAT THE TABLES DONT VANISH BENEATH THOSE PROCESSES; 00138130
COMMENT ENTRIES IN THE SLATE HAVE TWO WORDS. EACH ENTRY% 00140000
DESCRIBES AN INDEPENDENT ROUTINE WHICH NEEDS TO BE STARTED00141000
RUNNING. NOTHING TO DO STARTS THESE ROUTINES.% 00142000
THE FIRST WORD OF AN ENTRY IS A PARAMETER TO THE ROUTINE. 00143000
THE SECOND WORD OF AN ENTRY IS THE PRT ADDRESS OF THE% 00144000
ROUTINE.% 00145000
NSLATE AND LSLATE ARE POINTERS T THE SLATE.% 00146000
NSLATE POINTS AT LAST ENTRY WHICH WAS STARTED.% 00147000
LSLATE POINTS AT LAST ENTRY PLACED IN THE SLATE;% 00148000
REAL JOBNUM;% 00149000
COMMENT JOBNUM POINTS AT LAST ENTRY IN BED;% 00150000
COMMENT STACKUSE IS TRUE IF THE INDEPEDENT STACK IS NOT IN USE.00152000
OTHERWISE FALSE;% 00153000
BOOLEAN NOPROCESSOTOG;% 00154000
COMMENT NOPROCESSTOG IS TRUE IF NORMAL STATE PROCESSING IS% 00155000
ALLOWED, OTHERWISE IT IS FALSE. IT IS USED BY OVERLAY AND00156000
OTHERS TO PREVENT CONFUSION;% 00157000
REAL SOFTI; % NUMBER OF JOBS IN MIX HAVING SOFTWARE INTERRUPTS DECLARED 00157100
REAL WITCHINGHOUR,WORDOFEASE; 00157500
COMMENT THESE USED TO BE CONSTANTS IN THE OUTER BLOCK BUT WERE 00157600
MOVED HERE SO EVERYONE COULD USE THEM. THEY CONTAIN: 00157700
WITCHINGHOUR 5184000 00157800
WORDOFEASE @2525252525252525 00157900
; 00158000
DEFINE NDX=3#; % NUMBER OF ENTRIES PER JOB IN NFO ARRAY 00158100
ARRAY NFO[*]; %MIXMAX|NDX 00158200
COMMENT NFO CONTAINS THE FOLLOWING FOR EACH ACTIVE MIX INDEX; 00158300
% NFO[(MIX-1)|NDX] = FILE PARAMETER BLOCK DATA DESCRIPTOR 00158400
% NFO[(MIX-1)|NDX+1] = SEGMENT DICTIONARY NAME DESCRIPTOR 00158500
% NFO[(MIX-1)|NDX+2].[CF] = LOCATION OF BOTTOM OF STACK (B-WORD) 00158600
% NFO[(MIX-1)|NDX+2].[FF] = ESTIMATED CORE REQUIREMENTS 00158700
% NFO[(MIX-1)|NDX+2].[1:17] = CLOCK TIME AT BOJ 00158800
ARRAY ESTACK[*]; % 128% 00159000
ARRAY PROCTIME[*]; % MIXMAX+1% 00161000
COMMENT PROCTIME[I] CONTAINS PROCESSOR TIME FOR JOB WITH% 00162000
MIX INDEX = I;% 00163000
ARRAY IOTIME[*]; % MIXMAX+1% 00164000
COMMENT IOTIME[I] CONTAINS I-O TIME FOR JOB WITH MIX INDEX =1; 00165000
$ SET OMIT = NOT(NEWLOGGING) 00165009
DEFINE EUIOHOLDER=DIRECTORYTOP-5#, 00165800
EUTAPER=.98#, 00165810
DISKAVAILTABLEMAX=130#; 00165820
INTEGER NEUP; ARRAY EUIO[*]; ARRAY PEUIO[*]; 00166000
$ SET OMIT = NOT(SHAREDISK ) 00166002
$ SET OMIT = SHAREDISK 00166005
ARRAY AVTABLE[*] ; 00166006
$ POP OMIT 00166007
COMMENT NEUP.[CF] CONTAINS THE NUMBER OF EUS ON DKA. 00166010
NEUP.NEUF CONTAINS THE TOTAL NUMBER OF EUS ON THE SYSTEM. 00166025
EUIO AND PEUIO CONTAIN THE I-O TIME USED BY A GIVEN EU. 00166030
THIS INFORMATION IS USED BY GETUSERDISK IN AN ATTEMPT TO 00166040
MINIMIZE EU CONFLICT; 00166050
DEFINE MIXF = [3:5]#;% 00168000
ARRAY CHANIO[*]; 00169000
ARRAY CHANNEL[*]; % 5% 00170000
COMMENT CHANNEL[I] CONTAINS LOGICAL UNIT OF LAST DESCRIPTOR% 00171000
SENT OUT ON CHANNEL I;% 00172000
ARRAY FINALQUE[*]; % 32% 00173000
ARRAY LOCATQUE[*]; % 32% 00174000
COMMENT IOQUE,FINALQUE, AND LOCATQUE TOGETHER WITH UNIT FORM% 00175000
THE I-O QUEUE. AN I-O REQUEST FOR LOGICAL UNIT U REQUIRES00176000
THREE WORDS OF SPACE IN THE I-O QUEUE. IF THE REQUEST% 00177000
OCCUPIES POSITION S IN THE I-O QUEUE, THEN IOQUE[S] )% 00178000
I-O DESCRIPTOR FOR THIS REQUEST, FINAL[S] = I-O DESCRIPTOR00179000
SKELETON TO BE USED AT I-O COMPLETE TIME TO REBUILD% 00180000
I-O DESCRIPTOR, LOCATQUE[S] = LOCATION OF I-O DESCRIPTOR% 00181000
AT TIME OF REQUEST. LOCATQUE[S] CONTAINS SOME ADDITIONAL 00182000
INFORMATION. IN PARTICULAR:% 00183000
0- 2 = 5% 00184000
3- 7 = MIX INDEX OF REQUESTER% 00185000
8 = I/O IS READ LOCK WHICH HAD ERROR (SHAREDISK).00185100
9 = OLAY I/O (IOFINISH PLACES RESULT ON ERROR). 00185500
10 = NO MEM MESSAGE. 00186000
11 = ERROR RECOVERY IN PROCESS ON THIS I-O 00186100
12-17 = LOGICAL UNIT NUMBER% 00187000
18-32 = INDEX OF NEXT REQUEST TO BE DONE ON THIS UNIT00188000
OR @77777 IF NO NEXT REQUEST% 00189000
33-47 = ORIGINAL LOCATION OF I-O DESCRIPTOR.% 00190000
UNIT[U] CONTAINS INFORMATION ABOUT LOGICAL UNIT U.% 00191000
1- 4 = TYPE OF I/O DEVICE% 00192000
5-12 = ERROR FIELD OF LAST I/O DONE ON THIS UNIT% 00193000
13 = UNIT NOT READY BIT% 00194000
14 = ERROR BIT (ON IF ERROR)% 00195000
15 = WAIT BIT (ON IF UNIT IS WAITING FOR A CHANNEL00196000
16-17 = PROCESS BITS (USUALLY BOTH ON IF UNIT IS IN% 00197000
PROCESS OR BOTH OFF. WITH PRINTERS THE% 00198000
I-O FINISH SETS OFF 16 AND THE PRINTER% 00199000
FINISH SETS OFF 17)% 00200000
18-32 = INDEX OF FIRST I-O REQUEST FOR WHICH SERVICE 00201000
IS NOT COMPLETE% 00202000
33-47 = INDEX OF LAST UNSERVICED I-O REQUEST.% 00203000
THE SPACES NOT USED IN THE I-O QUEUE ARE LINKED TOGETHER% 00204000
THROUGH IOQUE. THE FIRST AVAILABLE IS IN IOQUEAVAIL;% 00205000
REAL IOQUESLOTS,IOQUEAVAIL; 00205500
ARRAY IOQUE[*]; 00206000
DEFINE RETURNIOSPACE(RETURNIOSPACE1) = 00206500
BEGIN IOQUESLOTS:=IOQUESLOTS+1; 00207000
IOQUE[RETURNIOSPACE1]:=IOQUEAVAIL; 00207500
IOQUEAVAIL:=RETURNIOSPACE1; 00208000
END#; 00208500
ARRAY UNIT[*]; 00209000
COMMENT UNIT NOW FILLED IN INITIALIZE; 00210000
ARRAY TINU[*]; 00241700
COMMENT TINU NOW FILLED IN INITIALIZE; 00241800
ARRAY WAITQUE[*]; % 8% 00278000
REAL NEXTWAIT,FIRSTWAIT;% 00279000
COMMENT WAITQUE IS A QUEUE OF UNITS FOR WHICH THERE ARE% 00280000
REQUESTS BUT NO CHANNEL IS AVAILABLE. NEXTWAIT AND% 00281000
FIRSTWAIT ARE POINTERS AT THE WAITQUE. NEXTWAIT IS THE% 00282000
NEXT AVAILABLE SLOT IN WAITQUE AND FIRSTWAIT POINTS AT% 00283000
NEXT UNIT TO BE USED WHEN A CHANNEL IS AVAILABLE;% 00284000
ARRAY LABELTABLE[*]; % 32% 00285000
ARRAY MULTITABLE[*]; % 32% 00286000
ARRAY RDCTABLE[*]; % 32% 00287000
ARRAY PRNTABLE[*];% 00288000
ARRAY REPLY[*];% 00289000
COMMENT LABELTABLE, MULTITABLE, AND RDCTABLE CONTAIN LABEL INFORMATION% 00290000
BY LOGICAL UNIT NUMBER AS FOLLOWS:% 00291000
LABELTABLE[I] CONTAINS THE FILE ID FOR LOGICAL UNIT I.% 00292000
MULTITABLE[I] CONTAINS THE CORRESPONDING MULTI-FILE ID.% 00293000
RDCTABLE[I] CONTAINS THE CORRESPONDING REEL NUMBER (IN [14:10]),00294000
CREATION DATE (IN [24:17]), AND CYCLE (IN [41:7]);% 00295000
$ SET OMIT = NOT(SHAREDISK) 00295999
REAL OPTION;% 00297000
REAL ILL,INQCT; 00299000
REAL PINGO; 00301000
REAL READQ,RRNCOUNT; DEFINE PUT=SET#; 00301100
$ SET OMIT = NOT(DATACOM ) 00301200
ARRAY TRANSACTION[*]; % 32% 00304000
DEFINE ETRLNG = 5#; % LENGTH OF ENTRY IN FILE BLOCK% 00305000
SAVE REAL PROCEDURE TWO(N); VALUE N; INTEGER N; 00306000
BEGIN REAL T=+1; 00307000
STREAM(N:=N:=47-N,T:=[T]); 00308000
BEGIN SKIP N DB; DS:=SET; END; 00308500
END TWO; 00309000
REAL SYLLABLE;% 00310000
$ SET OMIT = NOT(SHAREDISK) 00310099
$ SET OMIT = SHAREDISK 00310199
DEFINE SYSNO=0#, SYSMAX=1#; 00310200
$ POP OMIT 00310201
COMMENT ANALYSIS PLACES THE SYLLABLE THAT CAUSED THE INTERRUPT 00311000
IN SYLLABLE. THIS IS USED BY PRESENCE BIT, FLAG BIT, AND 00312000
VARIOIUS ERRORS;% 00313000
PROCEDURE FORGETUSERDISK(A,L);VALUE A,L;REAL A,L;FORWARD;% 00316000
REAL PROCEDURE PETUSERDISK(N,T);VALUE N,T;REAL N,T;FORWARD ; 00316100
$ SET OMIT = NOT DEBUGGING 00316999
$ SET OMIT = NOT DEBUGGING 00330999
ARRAY DALOC[*,*], DALOCROW[*]; 00333000
$ SET OMIT = NOT(BREAKOUT) 00333099
REAL OLAYMASK;% FOR LOCKING OUT GETMOREOLAYDISK BY MIX INDEX 00336000
PROCEDURE USERDISKSPECIALCASE(Q,R,U,J);VALUE Q,J;REAL Q,R,J; 00336100
ARRAY U[*]; FORWARD ; 00336110
DEFINE BASE=30268#,% 00338000
CHUNKSIZE=500#;% 00339000
REAL LEFTOFF; COMMENT POINTER TO CYCLE FOR OLAY;% 00341000
SAVE PROCEDURE DISKRTN(SEGNO, SIZE); 00363000
VALUE SEGNO, SIZE; 00363100
INTEGER SEGNO, SIZE; 00363200
FORWARD; 00363300
PROCEDURE FORGETSPDISK(SEG);VALUE SEG;REAL SEG;FORWARD; 00364000
SAVE INTEGER PROCEDURE DISKSPACE(NWORDS,P1MIX,AUX);% 00365000
VALUE NWORDS,P1MIX,AUX; 00366000
INTEGER NWORDS,P1MIX;REAL AUX; 00367000
FORWARD; 00368000
PROCEDURE STATUS;% 00369000
FORWARD;% 00370000
PROCEDURE INTERRUPT(TYPE);VALUE TYPE;REAL TYPE; FORWARD; 00370500
REAL PROCEDURE FINDOUTPUT(MID,FID,TYPE,FORMS,REEL,CDATE,CYCLE,KIND);% 00371000
VALUE MID,FID,TYPE,FORMS,REEL,CDATE,CYCLE,KIND;% 00372000
REAL MID,FID,TYPE,FORMS,REEL,CDATE,CYCLE,KIND; FORWARD;% 00373000
REAL PROCEDURE FINDINPUT(MID,FID,REEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN); 00374000
VALUE MID,FID,REEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN);% 00375000
REAL MID,FID,FEEL,CDATE,CYCLE,COBOL,UL,OF,MODE,FN; FORWARD;00376000
PROCEDURE STARTIMING(FN,U); VALUE FN,U; REAL FN,U; FORWARD;% 00377000
PROCEDURE FILEOPEN(X,A); VALUE X,A; INTEGER X,A; FORWARD; 00379000
SAVE PROCEDURE SAVEOPEN(A); VALUE A; REAL A; 00379100
BEGIN FILEOPEN(2,A) END; 00379200
PROCEDURE MIXPRINT(Q); VALUE Q REAL Q; FORWARD; 00379400
% TYPES <JOB SPECIFIERS> FOR EACH ACTIVE MIX INDEX 00379500
PROCEDURE JOBMESS(MIX,Q,A,B,C,D); VALUE MIX,Q,A,B,C,D; 00379600
REAL MIX,Q,A,B,C,D; FORWARD; 00379700
PROCEDURE SETNOTINUSE(U,RWL); VALUE U,RWL; REAL U,RWL; FORWARD; 00380000
DEFINE STOPTIMING=STARTTIMING#; 00382000
PROCEDURE FILLBUFFERS(CURRENT,FINAL,COBOL,NR); 00385000
VALUE CURRENT,FINAL,COBOL,NR; REAL CURRENT,FINAL,COBOL,NR; 00385500
FORWARD; 00386000
DEFINE GETBUFFERS=FILLBUFFERS#; 00387000
PROCEDURE REALFILECLOSE(A); VALUE A; REAL A; FORWARD; 00389000
SAVE PROCEDURE FILECLOSE(A); VALUE A; REAL A; 00389100
BEGN REALFILECLOSE(A) END; 00389200
REAL PROCEDURE DISKADDRESS(MID,FID,FPB3,A,H,IO); % (SHM)00390000
VALUE MID,FID,FPB3,A,H,IO; % (SHM)00390100
REAL MID,FID,FPB3,A,IO; ARRAY H[*]; % (SHM)00390200
FORWARD;% 00391000
PROCEDURE BLASTQ(U); VALUE U; REAL U; FORWARD;% 00392000
REAL PROCEDURE FILEHEADER(MID,FID,NROWS,SIZE,BLEN,RLEN,S);% 00393000
VALUE MID,FID,NROWS,SIZE,BLEN,RLEN,S;% 00394000
REAL MID,FID;% 00395000
INTEGER NROWS,SIZE,BLEN,RLEN,S; FORWARD;% 00396000
PROCEDURE PURGEIT(U); VALUE U; INTEGER U; FORWARD;% 00397000
REAL ESPTAB,ESPCOUNT; 00399000
REAL DIRDSK=@177; 00400500
REAL ESPDISKBOTTOM; % LOWEST ADDRESS OF ESPDISK 00401000
REAL ESPDISKTOP; % HIGHEST ADDRESS OF ESPDISK 00401100
REAL MESSAGEHOLDER;% 00402000
DEFINE USEDRA = OPTION.[47:1]#,% 00403000
USEDRB = OPTION.[46:1]#,% 00404000
BOJMESS =OPTION.[45:1]#,% 00405000
EOJMESS =OPTION.[44:1]#,% 00406000
OPNMESS =OPTION.[43:1]#,% 00407000
TERMGO =OPTION.[42:1]#,% 00408000
GIVEDATE = OPTION.[41:1]#,% 00409000
GIVETIME = OPTION.[40:1]#,% 00410000
SAMEBREAKTAPE=OPTION.[39:1]#, % NOT CURRENTLY USED, 3/73 00411000
AUTOPRINT=OPTION.[38:1]#, 00412000
CLEARWRS=OPTION.[37:1]#, 00413000
NOTIFYOP=OPTION.[36:1]#,% 00414000
DISCONDC = OPTION.[36:1]#, 00414100
COPNMESS=OPTION.[35:1]#,% 00415000
CLOSEMESS=OPTION.[34:1]#,% 00416000
ERRORMSG=OPTION.[33:1]#, 00416050
RETMSG=OPTION.[32:1]#, 00416100
LIBMSG=OPTION.[31:1]#, 00416200
SCHEDMSG=OPTION.[30:1]#, 00416300
SECMSG=OPTION.[29:1]#, 00416400
DSKTOG=OPTION.[28:1]#, 00416500
RELTOG=OPTION.[27:1]#, 00416520
PBDREL=OPTION.[26:1]#, 00416550
CHECKLINK = OPTION.[25:1]#, 00416560
DISKMSG=OPTION.[24:1]#, 00416570
LIBERR =(OPTION.[22:1] OR (SPOUTUNIT.[CF]=0))#, % FROM SPO%589-00416590
USEPRD=OPTION.[21:1]#,% %DS00416600
SVPBT =OPTION.[20:1]#,% 00416610
RSTOG=OPTION.[19:1]#, 00416620
AUTOUNLD=OPTION.[18:1]#, 00416630
AUTORN = OPTION.[17:1]#, %902-00416710
CODEOLAY=OPTION.[16:1]#, 00416730
COREST=OPTION.[15:1]#, 00416740
DATAOLAY=OPTION.[14:1]#, 00416750
HALTSET=OPTION.[13:1]#, 00416751
STOPTEST= OPTION.[8:1]#, 00416760
PUNCHLCK=OPTION.[7:1]#, 00416770
CDONLY=OPTION.[6:1]#, 00416780
PRTONLY=OPTION.[5:1]#, 00416790
SEPARATE=OPTION.[4:1]#, 00416800
MOD3IOS=OPTION.[2:1]#, 00416990
AUTOMESS = OPTION.[1:1]#, 00416992
AUTODS = OPTION.[1:1]#, % ACTS FOR OPERATOR %747-00416995
XXXXXX= OPTION.[0:1]#;% 00417000
DEFINE BOJBIT = 45[18:42:6]#, 00417010
EOJBIT = 44[18:42:6]#, 00417020
OPNBIT = 43[18:42:6]#, 00417030
COPNBIT = 35[18:42:6]#, 00417040
CLOSEBIT=34[18:42:6]#, 00417050
ERRRBIT = 33[18:42:6]#, 00417052
LIBBIT = 31[18:42:6]#, 00417060
SCHEDBIT=30[18:42:6]#, 00417070
SECBIT = 29[18:42:6]#, 00417075
RSBIT = 19[18:42:6]#, 00417080
NEVERBIT=62[18:42:6]#, 00417090
ALWAYSBIT=63[18:42:6]#; 00417100
REAL USERDISKBOTTOM; 00418000
% DISK ADDRESS OF USER DISK AVAILABLE TABLE 00418010
REAL DIRECTORYTOP; 00418050
% DISK ADDRESS OF DIRECTORYTOP SEGMENT--STORED IN M[1] 00418060
%BY MCP LOADER AND STORED IN MCP PRT(DIRECTORYTOP) 00418070
REAL DISKBOTTOM; 00418100
% DISK ADDRESS OF TOP FO BYPASS DIRECTORY, USED IN SCRAMBLE. 00418200
$ SET OMIT = NOT(SHAREDISK) 00418799
$ SET OMIT = SHAREDISK 00418849
REAL HOLDER,NEXTSLOT,BYPASS; 00418850
$ SET OMIT = NOT STATISTICS OR OMIT 00418859
DEFINE HOLDMAX = 30#; % MAXIMUM NUMBER OF ENTRIES IN HOLDLIST 00418900
COMMENT THE HOLDLIST CONTAINS A ONE WORD ENTRY FOR EACH PROCESS 00418910
THAT IS WAITING TO USE A FILE THAT IS ALREADY IN USE. 00418915
HOLDLIST[I].[FF]=THE CORE ADDRESS OF THE WORD THAT THE 00418920
WAITING PROCESS IS SLEEPING ON. 00418925
HOLDLIST[I].[CF]=THE DISK ADDRESS OF THE FILE HEADER 00418930
THAT IS BEING WAITED FOR. 00418935
HOLDLIST[I].[10:8]=MIX INDEX OF THE PROCESS THAT MADE THE 00418937
ENTRY. (TSSMCP ONLY) 00418938
HOLDLIST[I].[2:2]=THE SYSTEM NUMBER (SYSNO) OF THE SYSTEM 00418940
THAT MADE THE ENTRY (SHAREDISK ONLY). 00418945
HOLDLIST[I].[1:1] IS SET BY A SYSTEM TO NOTIFY ANOTHER 00418950
SYSTEM TO AWAKEN THE PROCESS THAT MADE THE ENTRY. 00418955
THE NSECOND ROUTINE EXAMINES THE HOLDLIST IN 00418960
ORDER TO CHECK FOR THIS CONDITION (SHAREDISK ONLY). 00418965
DIRECTORYSEARCH, NSECOND, AND CLEANOUT ARE THE PROCEDURES 00418970
THAT MANIPULATE THE HOLDLIST. 00418975
00418980
THE WORDS ASSOCIATED WITH DIRECTORY HANDLING ARE: 00418985
HOLDER.[CF] = DISK ADDRESS OF HOLDLIST. 00418990
.[FF] = NUMBER OF ENTRIES IN HOLDLIST. 00418995
NEXTSLOT = DISK ADDRESS OF FIRST HEADER IN QUEUE OF 00419000
EMPTY SLOTS IN DIRECTORY (NEXTSLOT QUEUE). 00419005
BYPASS.[CF] = LOWEST ADDRESS OF THE BYPASS DIRECTORY. 00419010
.[FF] = HIGHEST ADDRESS OF THE MAIN DIRECTORY. 00419015
ON SHAREDISK, HOLDER, NEXTSLOT AND BYPASS ARE KEPT IN THE FIRST 00419020
THREE WORDS OF THE DISK SEGMENT LOCATED AT DIRECTORYTOP+2. A 00419025
READ LOCK MUST BE DONE BEFORE ACCESSING THE HOLDLIST OR NEXTSLOT00419030
QUEUE OR EXPANDING EITHER THE MAIN OR BYPASS DIRECTORIES. 00419035
END COMMENT; 00419040
INTEGER RESTARTING; %PASSLEVEL CONTROL (RS) 00419100
$ SET OMIT = NOT(BREAKOUT) 00419104
DEFINE SCRAMBLE(SCRAMBLE1,SCRAMBLE2)=(-2| 00419110
((SCRAMBLE1.[6:18]+SCRAMBLE1.[24:24]) MOD MODULUS|MODULUS+ 00419120
(SCRAMBLE2.[6:18]+SCRAMBLE2.[24:24]) MOD MODULUS) + 00419130
DISKBOTTOM)#, 00419140
MODULUS=13#, DIRMOD=169#; 00419150
COMMENT 00419210
THE RELATIONSHIP BETWEEN MODULUS AND DIRMOD IS: 00419220
DIRMOD := MODULUS | MODULUS, WHERE MODULUS IS A LOW 00419230
ODD PRIME. (THE RECOMMENDED VALUE OF MODULUS IS 13). 00419240
FOR SYSTEMS WITH ONLY 4 MEMORY MODS, MODULUS MUST BE 00419250
SET TO A SMALLER VALUE SO THAT DIRECTORYBUILDER WILL 00419260
NOT GET A NO-MEM, MAKING IT IMPOSSIBLE TO HALT/LOAD. 00419270
IT IS SUGGESTED THAT MODULUS BE SET TO 11, DIRMOD TO 121 00419280
FOR A SYSTEM WITH 4 MODS. IT MAY BE NECESSARY TO SET IT 00419290
SMALLER, DEPENDING UPON DISK CONFIGURATION; 00419300
ARRAY FS[*,*]; ARRAY FSROW=FS[*]; 00419400
ARRAY USERDISK[*]; 00419900
$ SET OMIT = NOT DEBUGGING %763-00419999
$ SET OMIT = SHAREDISK 00421099
DEFINE LOCKDIRECTORY = 00421100
BEGIN IF NOT DIRECTORYTOG THEN SLEEP([TOGLE].DIRECTORYMASK);00421200
LOCKTOG(DIRECTORYMASK); 00421300
END#, 00421400
UNLOCKDIRECTORY = 00421500
BEGIN 00421600
UNLOCKTOG(DIRECTORYMASK); 00421700
END#; 00421800
$ POP OMIT 00421801
BOOLEAN OKSEGZEROWRITE; %20A-00422100
$ SET OMIT = NOT SHAREDISK 00422490
REAL LOGFREE,IOMASK,SAVEWORD; 00425000
REAL CORE; 00426000
COMMENT 00426100
CORE.[4:14] = MULTIPROCESSING FACTOR (|100) 00426200
CORE.[18:15] = SUM OF CORE ESTIMATES FOR ALL JOBS 00426300
NOW ACTIVE IN THE MIX (DIV 64) 00426400
CORE.[33:15] = ACMOUNT OF CORE MEMORY INITIALLY AVAILABLE FOR 00426500
PROCESSING NORMAL STATE JOBS (DIV 64) 00426600
PROCEDURE SELECTRUN(F); VALUE F; REAL F; FORWARD; 00426700
DEFINE SELECTION = INDEPENDENTRUNNER(P(.SELECTRUN),0,160)#; 00426800
PROCEDURE CONTROLCARD(A);VALUE A;REAL A; FORWARD;% 00427000
REAL PROCEDURE DIRECTORYSEARCH(A,B,C);VALUE A,B,C;% 00428000
REAL A,B,C; FORWARD;% 00429000
DEFINE HEADERUNLOCK=HU#, 00430000
HU(HU1,HU2,HU3)= 00430100
P(MKS,HU3,HU1,HU2,9,DIRECTORYSEARC,DEL)#; 00430200
REAL DIRECTORYSEARC=DIRECTORYSEARCH; 00430225
%%HEADERUNLOCK CAN BE USED TO WRITE IN THE DIRECTORY A CHANGED 00430250
%% HEADER, TURN OFF THE INTERLOCK BIT AND DO THE FORGETSPACE 00430275
%% IT MAY BE CALLED ONLY AFTER A DIRECTORYSEARCH(A,B,4) 00430300
%% THE PARAMETERS PASSED MUST BE (A,B,DS): 00430400
%% WHERE A,B ARE THE SAME AS PASSED TO THE DIRECTORYSEARCH 00430500
%% AND DS IS THE RESULT OF THAT DIRECTORYSEARCH 00430600
REAL OLDIDLETIME; 00430900
PROCEDURE ARTN(A,N); VALUE A,N; ARRAY A[*]; INTEGER N; FORWARD;% 00431000
SAVE PROCEDURE DISKIO(L,C,S,D); VALUE C,S,D; REAL L; INTEGER C,S,D;% 00432000
FORWARD;% 00433000
ARRAY MESSAGETABLE[*]; 00435000
DEFINE MESSAGETABLESIZE = 5#; % NUMBER OF MESSAGETABLE ENTRIES 00436000
DEFINE 00437000
OPTIONSZ = (MESSAGETABLE[0].[8:10])#, 00438000
TERMSGSZ = (MESSAGETABLE[1].[8:10])#, 00439000
KEYMSGSZ = (MESSAGETABLE[2].[8:10])#, 00440000
CCTABLSZ = (MESSAGETABLE[3].[8:10])#, 00441000
$ SET OMIT = PACKETS 00449999
$ SET OMIT = NOT(PACKETS) 00451499
DEFINE 00451500
SPOUT(SPOUT1)=SPOUTER(SPOUT1,0,1)#, 00451600
SPOUTIT(SPOUTIT1.SPOUTIT2)=SPOUTER(SPOUTIT1,0,SPOUTIT2)#; 00451700
PROCEDURE SPOUTER(MESSAGE,UNITNO,TYPE); 00451800
VALUE MESSAGE,UNITNO,TYPE; 00451900
REAL MESSAGE,UNITNO,TYP; 00452000
FORWARD; 00452100
DEFINE 00452200
FILEMESS=FMS#, 00452300
FMS(FMS1,FMS2,FMS3,FMS4,FMS5,FMS6,FMS7)= 00452400
FILEMESSAGE(FMS1,FMS2,FMS3,FMS4,FMS5,FMS6,FMS7,1)#; 00452500
PROCEDURE FILEMESSAGE(1,K,M,F,R,D,C,TYPE); 00452600
VALUE I,K,M,F,R,D,C,TYPE; 00452700
REAL I,K,M,F,R,D,C,TYPE; 00452800
FORWARD; 00452900
$ POP OMIT 00452901
PROCEDURE LBMESS(FN,SN,I1,I2,F,UNITNO,X); 00454000
VALUE FN,SN,I1,I2,F,UNITNO,X; 00454100
REAL FN,SN,I1,I2,E,UNITNO,X; 00454200
FORWARD; 00454300
PROCEDURE TERMINATE(MIX); VALUE MIX; REAL MIX; FORWARD; 00463100
SAVE PROCEDURE TERMNALMESSAGE(N); VALUE N; REAL N; FORWARD; 00463200
BOOLEAN PROCEDURE SYSTEMFILE(A,B);VALUE A,B; REAL A,B; FORWARD; 00463300
PROCEDURE ENTERSYSFILE(N); VALUE N; REAL N; FORWARD; 00464000
PROCEDURE COM5; FORWARD;% 00469000
$ SET OMIT = NOT(STATISTICS) 00469099
PROCEDURE ASR; FORWARD;% 00474000
PROCEDURE COM11; FORWARD;% 00475000
PROCEDURE COM13; FORWARD;% 00476000
PROCEDURE COMMUNICATE0; FORWARD; 00478000
PROCEDURE COMMUNICATE1; FORWARD; 00478500
PROCEDURE LIBRARYZERO; FORWARD; 00479500
PROCEDURE LIBRARYCOPY; FORWARD; 00480000
PROCEDURE FORMTIME(W,T); VALUE W,T; REAL W,T; FORWARD; 00480010
$ SET OMIT = NOT(DUMP OR DEBUGGING) 00480099
PROCEDURE DUMPCORE(B); VALUE B; REAL B; FORWARD; 00480199
$ POP OMIT 00480200
PROCEDURE COM19; FORWARD;% 00483000
PROCEDURE COM23; FORWARD;% 00487000
PROCEDURE INTRINSICTAABLEBUILDER(FH); 00489000
VALUE FH; REAL FH; FORWARD; 00490000
PROCEDURE MESSAGETABLEBUILDER; FORWARD; 00491000
$ SET OMIT = AUXMEM 00492000
DEFINE INVLDAUXIO = 11#, 00492100
LQOVFLOW = 13#, 00492200
$ SET OMIT = NOT (AUXMEM AND SHAREDISK) 00492300
ARRAY PUNTER[*]; 00493000
DEFINE PUNTSIZE = 11 00493100
$ SET OMIT = NOT SHAREDISK 00493200
+ 2 % INVLD AUXMEM IO 00493320
$ SET OMIT = NOT AUTODUMP 00493400
+ 19 % DUMP CARD 00493500
$ POP OMIT OMIT OMIT 00493600
#; 00493700
$ SET OMIT = NOT AUTODUMP 00644000
$ SET OMIT = NOT (SHAREDISK EQV AUXMEM) OR OMIT 00644100
DEFINE DUMPCRD = 13#, 00644200
DUMPADR = 26#; 00644300
$ POP OMIT 00644350
$ SET OMIT = (SHAREDISK OR NOT AUXMEM) OR OMIT 00644400
$ SET OMIT = NOT SHAREDISK OR AUXMEM OR OMIT 00644750
COMMENT THIS IS THE CODE ON THE DUMP CARD (ALL NUMBERS ARE OCTAL):00645000
:20: 20,20,NOP,NOP TELLS ANALYZER ALL I/O RES ARE OK00645010
:21: STD,5,BFW BRANCH TO 23 00645020
:22: INI,0,LFU TIMER - LOOP UNTIL INTERRUPTED 00645030
:23: 10,LOD,21,STD SAVE M[8], RESTORED BY 2ND CARD 00645040
:24: 25,IIO,2,LBU START I/O THEN WAIT AT TIMER 00645050
:25: 0140000007700035 I/O DESC FOR 77 SEG WRITE FROM 3500645060
:26: 0140000047400157 I/O DESC FOR 74 SEG READ OF CODE 00645070
:27: OPDC 14,DIA 26,10,BFW I/O 1 - PICK UP RES DESC. 00645080
:30: OPDC 15,DIA 26,6,BFW I/O 2 - DIAL TO ERR FIELD. 00645090
:31: OPDC 16,DIA 26,2,BFW I/O 3 - BRANCH INTO I/O 4 00645100
:32: OPDC 17,DIA 26, I/O 4 00645110
DESC 24,CBD 7 BRANCH TO 24 FOR RETRY IF ERRORS 00645120
:33: DESC 37,BFW GO TO 37 1ST TIME, SEE 41 FOR 2ND00645130
:34: INI,0,LFU DATACOM - LOOP UNTIL INTERRUPTED 00645140
:35: 0000000000000501 DISK ADDRESS FOR WRITE 00645150
:36: INI,0,LFU FREEADDRESS - LOOP ON INTERRUPT 00645160
:37: 200,157,SND,240 STORE DISK ADDR FOR READ. SET 24000645170
TO OPERAND FOR DESC AT 41 00645180
:40: STD,OPDC 26,25,STD PUT I/O DESC INTO 25 00645190
:41: DESC 240,37,STD,NOP SET 37 FOR BRANCH TO 240 FROM 33 00645200
:42: 16,LBU BRANCH TO 24 TO START THE READ; 00645210
$ POP OMIT 00645900
SAVE PROCEDURE RESULT; 00646900
BEGIN 00647000
GO TO P([18]); % TIMER IS A LOOP ON INTERRUPTS 00648000
END; 00649000
00649999
SAVE PROCEDURE PUNT(I); VALUE I; REAL I; 00650000
BEGIN REAL T=-3; 00650250
REAL TMB, RSLT=RESULT; 00650500
LABEL HA,HB; 00650750
I:=IF I=0 THEN T ELSE PUNTER INX I; 00651000
STREAM(Q:=P(0,RDF): I, 00651800
A:=18, D:=I:=PUNTER INX 0); 00652000
BEGIN DS:= 16 LIT"-SYSTEM HANG, F="); %104-00652400
SI:=LOC Q; SI:=SI+3; 00652600
5(DS:=3 RESET; 00652800
3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 00653000
DSD:=2 LIT": "; SI:=1; 00653200
63(IF SC!"~" THEN DS:=CHR); DS:=LIT"~"; 00653400
DI:=A; DS:=8 LIT"29290+JI"; % INI,INI,4,BBW 00653600
SI:=A; DS:=44 WDS; 00653800
DI:=A; DI:=DI+8; % IOBUSY- 00654000
DS:=4 LIT"002("; % 0,RTN 00654200
DI:=DI+28; % IOCOMPLETE-LOD R,RTN 00654400
DS:=32 LIT"0 +A+:2(OU+A+:2(0Y+A+:2(0!+A+:2("; 00654600
END; 00654800
P(HP2); 00655000
HA: TMB:=I&60[3:42:6]; 00655200
P([TMB],IIO); 00655400
HB: DO IF (TMB:=P(MKS,RSLT)) = 0 THEN % IO BUSY 00655600
BEGIN P(MKS,RSLT,DEL); GO HA END 00655800
UNTIL TMB.[3:6]=60; 00656000
IF TMB.[CF]<I THEN GO TO HB; 00656200
IF TMB.[FF]!0 THEN GO TO HA; 00656400
$ SET OMIT = NOT AUTODUMP 00656500
IF NOT HALTSET AND PUNTER[DUMPADR]=@501 THEN 00656600
BEGIN 00656800
STREAM(S:=[PUNTER[DUMPCRD]], D:=@20); 00657000
BEGIN SI:=S; DS:=19 WDS; END; 00657200
GO TO P(0,STS,0,STF,[M[@20]]); 00657400
END; 00657600
$ POP OMIT 00657700
DO UNTIL FALSE; 00657800
END; 00662000
$ SET OMIT = DATACOM 00689990
$ RESET SEPTICTANK 00690000
$ POP OMIT 00699990
$ SET OMIT = NOT DATACOM 00699999
$ SET OMIT = NOT(DFX) 00999999
SAVE PROCEDURE STARTIO(U); VALUE U; REAL U; FORWARD; 01165000
SAVE PROCEDURE COMPLEXSNOOZE(PRI,CODE); VALUE PRI; REAL PRI,CODE; 01240000
BEGIN SNOOZE(PRI,1,P(.CODF,LOD)); END; 01240100
DEFINE COMPLEXSLEEP(COMPLEXSLEEP1)=COMPLEXSNOOZE(PRYOR[P1MIX], 01240200
COMPLEXSLEEP1)#; 01240300
PROCEDURE USASITAPE(AREA,TYPE,FROM,U,DIR); %RHR 01250100
VALUE AREA,FROM,U,DIR; REAL AREA,TYPE,FROM,U,DIR; 01250200
BEGIN REAL PIN,Y; 01250300
ARRAY ULAB[*]; 01250400
LABEL EXIT,ERROR,VOL,BAD,WAIT,TIP,ETIP; 01250500
SUBROUTINE LABELSPACE; 01250600
BEGIN ULAB:=[M[SPACE(11)]]&10[8:38:10]; 01250700
MOVE(10,ULAB.[CF]-1,ULAB,[CF]); 01250800
END LABELSPACE; 01250900
SUBROUTINE VOL1FILL; 01251000
BEGIN STREAM(AREA,ULAB); 01251100
BEGIN DS:=8 LIT " LABEL "; DI:=DI+1; SI:=AREA; 01251200
SI~SI+11;IF SC=" " THEN DS~7LIT"0" ELSE DS~7CHR; 01251300
DI~DI+37; %MID 01251310
SI:=AREA; SI:=SI+5; DS:=5 CHR; %PHYSICAL TAPE NO. 01251400
END; 01251500
END VOL1FILL; 01251600
SUBROUTINE HDR1CHK; 01251700
BEGIN STREAM(Y:=0:AREA,X:=0); 01251800
BEGIN DI:=LOC X; DS:=4 LIT "HDR1"; 01251900
SI:=AREA; DI:=LOC X; 01252000
IF 4 SC=DC THEN TALLY:=1; 01252100
Y:=TALLY; 01252200
END; 01252300
Y:=P; 01252350
END HDR1CHK; 01252400
SUBROUTINE HDR1FILL; 01252500
BEGIN STREAM(AREA,ULAB); 01252600
BEGIN SI:=AREA; SI:=SI+4; 01252700
DI:=DI+17; DS:=7 CHR; %FID 01252800
SI:=SI+17; DS:=3 CHR; %REEL 01252900
SI:=SI+11; DS:=5 CHR; %C-DATE 01253000
SI:=SI-8; DS:=2 CHR; %CYCLE 01253100
SI:=SI+7; DS:=5 CHR; %P-DATE 01253200
DI:=DI+1; SI:=SI+2; 01253300
DS:=5 CHR; %BLOCK COUNT 01253400
DS:=7 CHR; %RECORD COUNT 01253500
END; 01253600
END HDR1FILL; 01253700
SUBROUTINE HARDFILL; 01253800
BEGIN RTN:=PRNTABLE[U].[30:18]; 01253900
STREAM(PTN,AREA,ULAB); 01254000
BEGIN SI:=LOC PIN; DI:=DI+53; 01254100
DS:=5 DEC; DI:=ULAB; %PHYSICAL TAPE NO. 01254200
DS:=8 LIT " LABEL "; 01254300
END; 01254600
ULAB[1]:=MULTITABLE[U]; 01254650
END HARDFILL; 01254700
LABELSPACE; 01254800
IF FROM=1 THEN 01254900
BEGIN VOL1FILL; 01255000
P(WAITIO(@140000005,@377,U);DEL); 01255100
P(WAITIO(AREA INX @120540000000,@377,U),DEL); 01255200
HDR1CHK; 01255300
IF Y THEN HDR1FILL ELSE GO TO ERROR; 01255400
P(WAITIO(@340000005,@55,U),DEL); 01255450
P(WAITIO(@340000005,@55,U),DEL); 01255500
GO TO WAIT; 01255600
END; 01255700
IF FROM =2 THEN 01255800
BEGIN IF TYPE=1 THEN 01255900
BEGIN VOL1FILL; 01256000
VOL: P(WAITIO(AREA INX @120540000000,@377,U),DEL); 01256100
HDR1CHK; 01256200
IF Y THEN HDR1FILL ELSE GO TO ERROR; 01256300
P(WAITIO(@340000005,@377,U),DEL); 01256400
GO TO WAIT; 01256500
END; 01256600
IF TYPE=2 THEN 01256700
BEGIN HDR1FILL; 01256800
HARDFILL; 01256900
GO TO EXIT; 01257000
END; 01257100
END; 01257200
IF FROM=3 OR FROM=4 THEN 01257300
BEGIN IF TYPE=1 THEN 01257400
BEGIN VOL1FILL; 01257500
GO TO VOL; 01257600
END; 01257700
IF TYPE=2 OR TYPE=4 THEN 01257800
BEGIN HDR1FILL; 01257900
HARDFILL; 01258000
GO TO EXIT; 01258100
END; 01258200
IF TYPE=3 OR TYPE=5 THEN 01258300
BEGIN IF DIR=0 THEN 01258400
BEGIN P(WAITIO(@340000005,@377,U),DEL); 01258500
P(WAITIO(@340000005,@377,U),DEL); 01258600
P(WAITIO(AREA INX @120540000000,@377,U),DEL); 01258700
END ELSE 01258800
P(WAITIO(AREA INX @120740000000,@377,U),DEL); 01258900
HDR1CHK; 01259000
IF Y THEN HDR1FILL ELSE GO TO ERROR; 01259100
HARDFILL; 01259200
GO TO WAIT; 01259300
END; 01259400
IF TYPE=6 THEN 01259500
BEGIN HDR1FILL; 01259600
HARDFILL; 01259700
STREAM(ULAB); 01259800
BEGIN DI:=ULAB; DI:=DI+39; 01259900
DS:=1 LIT "1"; 01260000
END; 01260100
GO TO EXIT; 01260200
END; 01260300
END; 01260400
WAIT: PTN:=0; 01260425
TIP: IF((TWO(U) AND P(RRR)) !0) THEN 01260450
GO TO EXIT ELSE SLEEP([CLOCK], NOT CLOCK); 01260455
PTN:=PTN+1; 01260460
IF(PTN>120)THEN GO TO EXIT ELSE GO TO TIP; 01260465
ERROR: P(WAITIO(@4200000000,@377,U),DEL); 01260500
STREAM(T:=TINU[U],ULAB); 01260600
BEGIN SI:=LOC T; SI:=SI+5; 01260700
DS:=LIT "#"; DS:=3 CHR; 01260800
DS:=22 LIT " INVALID USASI. RW/L~"; 01260900
END; 01261000
SPOUT(ULAB.[CF]); LABELTABLE[U]:=@314;; 01261100
TYPE~0; PTN~0; 01261150
ETIP: IF((TWO(U) AND P(RRR)) !0) THEN 01261160
GO TO BAD ELSE SLEEP([CLOCK], NOT CLOCK); 01261170
PTN:=PTN+1; 01261180
IF(PTN>120) THEN GO TO BAD ELSE GO TO ETIP; 01261200
EXIT: MOVE(10,ULAB.[CF],AREA.[CF]); 01261300
FORGETSPACE(ULAB.[CF]); 01261400
BAD: 01261450
END USASITAPE; %RHR 01261500
SAVE PROCEDURE SNOOZE(NEWPRI,ADDRESS,MASK); 02000000
VALUE NEWPRI, ADDRESS, MASK; 02001000
REAL NEWPRI; 02002000
NAME ADDRESS; 02002500
ARRAY MASK[*]; 02003000
BEGIN 02004000
REAL TRYHERE=NT1; 02004500
$ SET OMIT = NOT(NEWLOGGING) 02004599
LABEL BEDENTER; 02004900
IF (JOBNUM:=JOBNUM+2) GEQ JOBNUMAX THEN PUNT(9); 02005000
PRYOR[P1MIX].[FF]~ NEWPRI~ NEWPRI+1; 02006000
FOR TRYHERE~JOBNUM STEP -2 UNTIL 2 DO 02007100
BEGIN 02007200
IF PRYOR[(BED[TRYHERE]~BED[TRYHERE-2]).[3:5]].[FF] 02007300
< NEWPRI THEN GO TO BEDENTER; 02007400
BED[TRYHERE+1] ~ BED[TRYHERE-1]; 02007500
END; 02007600
BEDENTER: 02008000
BED[TRYHERE] ~ P(ADDRESS & P1MIX[3:43:5], RDF); 02008100
BED[TRYHERE+1] ~ MASK; 02008200
STOPLOG(P1MIX,1); 02008300
GO TO NOTHINGTODO; 02008400
END SLEEP; 02009000
SAVE PROCEDURE INDEPENDENTRUNNER(ROUTINE,PARAMETER,SSZ); 02012000
VALUE ROUTNE,PARAMETER,SSZ; 02013000
ARRAY PARAMETER[*]; 02014000
REAL ROUTINE,SSZ; 02015000
BEGIN LSLATE:= LSLATE+2 AND SLATEEND;% 02016000
IF NSLATE=LSLATE THEN PUNT(7); 02017000
SLATE[LSLATE] ~ PARAMETER;% 02018000
SLATE[LSLATE+1]:=ROUTINE&SSZ[CTF]; 02019000
END; 02020000
REAL KEYBOARDCOUNTER; 02020500
REAL PROCEDURE KEYIN(B); VALUE B; BOOLEAN B; FORWARD;% 02021000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02021099
BOOLEAN PROCEDURE WHYSLEEP(MASK); VALUE MASK; REAL MASK; FORWARD;% 02022000
LABEL P1PROCESS,P2PROCESS;% 02023000
REAL ONEOHONE = @101,ONEOHTWO = @102;% 02024000
SAVE PROCEDURE RUN(MIX); VALUE MIX; REAL MIX; 02025000
BEGIN P1MIX ~ MIX;% 02026000
$ SET OMIT = NEWLOGGING 02026999
STARTLOG(MIX); 02027000
$ POP OMIT 02027001
STACKUSE ~ TRUE;% 02028000
GO TO EXTERNAL;% 02029000
END;% 02030000
REAL NUMESS;% 02031000
SAVE PROCEDURE SAVEMIX(MIX); VALUE MIX; REAL MIX;% 02032000
BEGIN INDEPENDENTRUNNER(P(.RUN),MIX,0); 02033000
$ SET OMIT = NEWLOGGING 02033999
STOPLOG(MIX,0); 02034000
$ POP OMIT 02034001
END;% 02035000
SAVE PROCEDURE HALT;% 02036000
BEGIN NOPROCESSTOG ~ NOPROCESSTOG+1;% 02037000
IF P2MIX > 0 THEN% 02038000
BEGIN P(HP2);% 02039000
$ SET OMIT = NOT(NEWLOGGING) 02039099
SNOOZE(-1,1,1); 02040000
IF P2MIX > 0 THEN% 02041000
BEGIN SAVEMIX(P2MIX);% 02042000
P2MIX~0; TOGLE~TOGLE AND NOT HP2MASK; 02043000
END;% 02044000
END;% 02045000
END;% 02046000
SAVE PROCEDURE KILL(A); VALUE A; ARRAY A[*];% 02047000
BEGIN P(64,STS);% 02048000
FORGETSPACE(A);% 02049000
GO TO NOTHINGTODO;% 02050000
END;% 02051000
REAL PBCOUNT; 02052200
BOOLEAN PROCEDURE OLAY(LOC); VALUE LOC; REAL LOC; FORWARD; 02052500
PROCEDURE SEEKNAME(A,B,C,D,E,N,XLST); VALUE A,B; 02052700
REAL A,B,C,D,E,N; ARRAY XLST[*]; FORWARD; 02052800
PROCEDURE UNHOOQUE(MIX);% 02053000
VALUE MMIX;% 02054000
INTEGER MIX;% 02055000
BEGIN% 02056000
REAL U,S,SN,T,X,I,PROCE;% 02057000
NAME OLDQ=X; 02057500
LABEL DOLP,DELINKIT; 02058000
FOR U~0 STEP 1 UNTIL 31 DO% 02059000
BEGIN% 02060000
IF(S~UNIT[U].[FF])!@77777 THEN 02061000
BEGIN% 02062000
WHILE (SN~LOCATQUE[S].[FF])!@77777 DO% 02063000
BEGIN IF (T~NFLAG(LOCATQUE[SN])).[3:5] =% 02064000
MIX THEN% 02065000
IF LOCATQUE[SN].[11:1] THEN S~SN ELSE 02065100
BEGIN% 02066000
LOCATQUE[S]~LOCATQUE[S]&T[FTF];% 02067000
RETURNIOSPACE(SN); 02068000
END ELSE% 02070000
S~SN;% 02071000
END% 02072000
END 02072100
END; 02072200
$ SET OMIT = NOT DFX; 02072490
DOLP: FOR U~0 STEP 1 UNTIL 31 DO% 02075000
BEGIN% 02076000
IF (S~(T~UNIT[U]).[FF])!@77777 THEN 02077000
BEGIN% 02078000
IF LOCATQUE[S].[3:5]=MIX THEN% 02079000
BEGIN% 02080000
IF (X~T.[13:5])=0 OR X=16 THEN 02081000
GO DELINKIT; 02082000
IF X=4 THEN% 02087000
BEGIN% 02088000
IF LOCATQUE[S].[FF]=@77777 THEN% 02089000
BEGIN% 02090000
I~FIRSTWAIT;% 02091000
WHILE WAITQUE[I]!U% 02092000
DO I ~ I+1 AND 32;% 02093000
WAITQUE[I]~% 02094000
WAITQUE[NEXTWAIT~NEXTWAIT% 02095000
+31 AND 31];% 02096000
UNIT[U]~T&@77777[13:28:20]; 02097000
END ELSE 02097200
DELINKIT: UNIT[U]:=T&LOCATQUE[S][FTF]; 02097400
$ SET OMIT = NOT DFX 02097590
RETURNIOSPACE(S); 02100000
END ELSE 02100400
PROCE~((U!23 AND U!24) OR X=3) 02101000
AND X!25 OR PROCE; 02101100
END% 02102000
END$ 02103000
END ;% 02104000
IF PROCE THEN% 02105000
BEGIN% 02106000
SLEEP([CLOCK],NOT CLOCK); PROCE~0; GO TO DOLP; 02107000
END;% 02108000
END UNHOOQUE;% 02109000
DEFINE PSF-3:4#, 02110050
TERMSET(TERMSET1)=(PRTROW[TERMSET1].[6:1]=1)#, 02110100
NOTERMSET(NOTERMSET1)=(PRTROW[NOTERMSET1].[6:1] NEQ 1)#, 02110200
TERMGOING(TERMGOING1)=(PRTROW[TERMGOING1].[PSF]=3)#, 02110250
BREAKSET(BREAKSET1)=(PRTROW[BREAKSET1].[PSF]=4)#, %139-02110260
STOPSET(STOPSET1)=(PRTROW[STOPSET1].[PSF]=2)#; 02110300
REAL PROCEDURE GETESPDISK;FORWARD;% 02111000
PROCEDURE CHANGEMCP(KTR); VALUE KTR; REAL KTR; FORWARD; 02111100
PROCEDURE CHANGEINTRINSICFILE(KTR); VALUE KTR; REAL KTR; FORWARD; 02111200
$ SET OMIT = NOT(DEBUGGING) 02111299
REAL PROCEDURE ANALYSIS; FORWARD; 02111400
PROCEDURE SHORTCOMMUNICATE; FORWARD; 02111500
PROCEDURE CONTINUITYBIT; FORWARD; 02111600
REAL CCTBLWORD; 02112000
DEFINE CCCOUNT = CCTBLWORD.[FF]#, 02112100
CCTBLADDR = CCTBLWORD.[CF]#; 02112200
REAL READERA,READERB; 02112500
$ SET OMIT = NOT(PACKETS) 02113079
ARRAY PSEUDO[*]; %PSEUDOMAX; 02113080
ARRAY PSEUDOMIX[*], NYLONZIPPER[*]; %MIXMAX 02113085
DEFINE PACKETPAGE[PACKETPAGE1]=PSEUDO[PACKETPAGE1].[22:26]#; 02113086
DEFINE PACKETREC[PACKETREC1]=PSEUDO[PACKETREC1].[18:3]#; 02113087
DEFINE PACKETPBD[PACKETPBD1]=PSEUDO[PACKETPBD1].[8:10]#; 02113088
DEFINE PACKETACT[PACKETACT1]=PSEUDO[PACKETACT1].[2:6]#; 02113089
DEFINE PACKETERR[PACKETERR1]=PSEUDO[PACKETERR1].[1:1]#; 02113090
DEFINE PAGESIZE=300#; % SAME AS PBDROWSZ AT 08699100 %732-02113091
DEFINE PAGEFULL=(PAGESIZE DIV 3)|5-40#; % ALLOW FOR 8 INFO RECORDS 02113092
$ POP OMIT 02113099
PROCEDURE MESSAGEWRITER;% 02114000
BEGIN REAL RWC=+0, MSCW=-2; 02115000
REAL T=+1;% 02116000
LABEL L;% 02117000
P(0); 02118000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02119009
$ SET OMIT = DCSPO 02119019
L: 02119020
$ POP OMIT 02119021
P(WAITIO(MESSAGEHOLDER INX 1,0,0,25)); 02120000
P(DEL);% 02121000
NUMESS ~ NUMESS-1;% 02122000
T ~ M[MESSAGEHOLDER].[18:15]; 02123000
FORGETSPACE(MESSAGEHOLDER INX 1); 02124500
IF T ! 0 THEN% 02125000
BEGIN MESSAGEHOLDER.[33:15] ~ T;% 02126000
GO TO L% 02127000
END;% 02128000
MESSAGEHOLDER ~ 0;% 02129000
KILL([MSCW]); 02130000
END;% 02131000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02131005
$ SET OMIT = PACKETS 02131999
$ SET OMIT = NOT(PACKETS) 02132299
PROCEDURE SPOUTER(MESSAGE,UNITNO,TYPE); 02132300
VALUE MESSAGE,UNITNO,TYPE; 02132400
REAL MESSAGE,UNITNO,TYPE; 02132500
$ POP OMIT 02132501
BEGIN REAL MKSCW=MESSAGE-1; 02133000
INTEGER MIX; 02133010
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02133011
$ SET OMIT = (DATACOM AND DCSPO) %950-02133122
INTEGER LFT; %950-02133123
$ POP OMIT %950-02133124
$ SET OMIT = NOT(PACKETS) 02133129
DEFINE PACKETFREE=PSEUDO[UNITNO].[21:1]#, 02133130
PACKETMASK=#400000000#; 02133140
REAL PSD,PWS,X,Z,BB; 02133150
INTEGER NT1,R,S,T; ARRAY BUF[*]; 02133200
$ SET OMIT = NOT(DATACOM AND DCSPO) OR OMIT %203-02133279
R:=UNITNO.[CF]; UNITNO:=0; 02133300
IF R=0 THEN IF P1MIX!0 THEN R:=PSEUDOMIX[P1MIX]; 02133350
IF R>31 AND R<64 THEN UNITNO:=R; 02133380
$ POP OMIT 02133381
$ SET OMIT = NOT(DATACOM AND DCSPO) 02133499
MESSAGE ~ P(.MESSAGE,LOD).[33:15]-1;% 02134000
MIX ~ M[MESSAGE-1].[9:6]; 02134005
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02134008
$ SET OMIT = NOT(PACKETS) 02134889
IF TYPE THEN 02134890
$ POP OMIT 02134891
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02134899
BEGIN 02134906
IF MESSGEHOLDER = 0 THEN% 02135000
BEGIN MESSAGEHOLDER ~ MESSAGE;% 02136000
INDEPENDENTRUNNER(P(.MESSAGEWRITER),0,64); 02137000
END% 02138000
ELSE M[MESSAGEHOLDER.[18:15]].[18:15] ~ MESSAGE; 02139000
M[MESSAGE]~0&MIX[4:43:5]; 02140000
MESSAGEHOLDER.[18:15] ~ MESSAGE;% 02141000
END; 02141020
M[MESSAGE-1].[9:6] ~ 0;% 02142000
M[MESSAGE-1].[AREATYPEF] := SPOUTMSGAREAV;% %167-02142100
IF P(MKSCW.[33:15],DUP) = 0 THEN% 02143000
BEGIN ; 02143050
STREAM(N~9:X~MESSAGE+1); 02144500
BEGIN SI ~ X;% 02145000
L: IF SC ! "~" THEN% 02146000
BEGIN IF SC= " " THEN% 02147000
BB: BEGIN SI~ SI+1; 02148000
IF SC=" " THEN GO BB; 02149000
IF SC = ALPHA THEN% 02150000
BEGIN SI ~ SI-1;% 02151000
DS ~ CHR;% 02152000
END ELSE GO TO L;% 02154000
END;% 02155000
IF SC = @14 THEN% 02156000
BEGIN DS ~ CHR;% 02157000
Q: IF SC = @14 THEN% 02158000
BEGIN SI ~ SI+1;% 02159000
GO TO Q; 02160000
END;% 02162000
GO TO L;% 02163000
END;% 02164000
DS ~ CHR;% 02165000
GO TO L;% 02167000
END;% 02168000
DS ~ CHR;% 02169000
N ~ DI; 02171000
END;% 02172000
NT1~P;NT1~((NT1.[33:15]-(MESSAGE+1))|8+NT1.[30:3])|6; 02173000
END ELSE NT1 ~ P | 6; 02173050
$ SET OMIT = NOT(PACKETS) 02173069
IF UNITNO!0 THEN IF PACKETPAGE[UNITNO-32]>1 THEN 02173075
BEGIN UNITNO:=UNITNO-32; 02173080
IF NOT PACKETFREE THEN SLEEP([PSEUDO[UNITNO]],PACKETMASK);02173085
IF (PSD:=PACKETPAGE[UNITNO])>1 THEN 02173087
BEGIN % JUST TO BE SURE 02173088
PACKETFREE:=FALSE; 02173090
Z:=IF (PSW:=PACKETREC[UNITNO]) THEN 60 ELSE 30; 02173095
S:=((Y:=IF NT1>725 THEN 120 ELSE NT1 DIV 6)+7) DIV 8; 02173100
BUG:=[M[T:=SPACE(Z+S)]]&Z[8:38:10]; 02173110
M[BUF-2].[9:6]:=0; 02173120
STREAM(N:=S,AA:=MESSAGE+1,BUF:=BUF INX Z); 02173150
BEGIN SI:=AA; DS:=N WDS END; 02173160
DISKWAIT(-T,Z,PSD+PSW DIV 2); 02173210
R:=(PSW|18) MOD 30; 02173220
IF (BB:=BUF[R+17].[CF]) GEQ PAGEFULL THEN 02173230
BEGIN STREAM(BUF:=[BUF[R]]); 02173240
BEGIN DS:=12LIT" "; 02173245
DS:=28LIT"ALL FURTHER MESSAGES LOST "; 02173250
2(DI:=DI+48); DS:=6LIT":|5908"; 02173255
END; 02173260
PACKETPAGE[UNITNO]:=1; % TO MARK OVERFLOW 02173265
END 02173270
ELSE BEGIN P(@1540005000100000&(RB+1)[CTC]); % PBDSTOPPER 02173275
IF PSW=0 THEN 02173280
BEGIN P(BUF[29],XCH); 02173282
P([BUF[29]],STD); 02173284
DISKWAIT(T,30,PSD+5); 02173286
P([BUF[29]],STD); 02173288
END ELSE 02173290
P([BUF[R-1]],STD); 02173292
BUF[R+17]:=@1540000104000000&BB[CTC]& 02173294
(S+2+(M[BUF INX Z].[1:5]!">"))[8:38:10]; 02173296
FORMTIME([LFT],XCLOCK~P(RTR)); %154-02173297
STREAM(N:=S-1,CL:=S|8-Y,AA:=BUF INX Z,BB := LFT,%154-02173300
BUF:=[BUF[R]]); 02173301
BEGIN DS := 7 LIT " "; SI := LOC BB; DS := 8 CHR; 02173305
DS := 9 LIT " "; SI := AA; %154-02173306
IF SC!">" THEN DS:=8 CHR ELSE 02173310
BEGIN DI:=DI-8; 8(IF SC!">" THEN DS:=CHR ELSE 02173315
BEGIN DI:=DI+1; SI:=SI+1; END); 02173320
END; N(DS:= 8 CHR); DI:=DI-CL; AA:=DI; 02173325
SI:=AA; SI:=SI-1; 02173330
IF SC="~" THEN BEGIN DI:=DI-1; DS:=LIT" "; END; 02173335
CL(DS:=LIT" "); 02173340
END;END; 02173345
DISKWAIT(T,Z,PSD+PSW DIV 2); 02173350
IF PACKETPAGE[UNITNO]>1 THEN 02173360
IF PSW=0 THEN 02173362
BEGIN PACKETPAGE[UNITNO]:=PSD+3; 02173364
PACKETREC[UNITNO]:=4; 02173366
END ELSE 02173368
PACKETREC[UNITNO]:=PSW-1; 02173370
PACKETFREE:=TRUE; 02173375
FORGETSPACE(BUF); 02173380
END; % JUST TO BE SURE 02173383
END; 02173385
IF NOT TYPE THEN BEGIN FORGETSPACE(MESSAGE+1); P(XIT); 02173389
END; 02173390
$ POP OMIT 02173391
IOTIME[P1MIX] ~ *P(DUP)+NT1;% 02174000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 02174005
$ SET OMIT = DCSPO 02175002
IF (NUMESS~ NUMESS+1)>0 THEN 02175003
$ POP OMIT 02175004
BEGIN 02175010
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02175020
SLEEP([NUMESS],-0);% 02176000
END; 02176100
END;% 02177000
PROCEDURE ENDOFDECK(R,TUSTA);VALUE R,TUSTA; REAL R,TUSTA; FORWARD; 02177100
PROCEDURE PBIO(A,B); VALUE A; REAL A,B; FORWARD; 02178500
REAL TERMINALCLOCK; 02179000
PROCEDURE TERMINATE(MIX); VALUE MIX; REAL MIX;% 02180000
BEGIN IF MIX LEQ 0 THEN BYBY("MCP DS-ED~",10); 02181000
IF JARROW[MIX] NEQ 0 THEN 02182000
BEGIN 02183000
IF NOTERMSET(MIX) THEN 02184000
BEGIN 02185000
TERMINALCLOCK:=CLOCK+P(RTR); 02185900
PRTROW[MIX].[FF]:=MIX.[FF]; 02186000
PRTROW[MIX].[PSF]:=1; 02186050
END; 02186100
END; 02186300
END;% 02187000
REAL PROCEDURE PLACEFINDER(S, A, L); 02187100
VALUE S, A; 02187200
REAL S, A, L; 02187300
FORWARD; 02187400
ARRAY CIDROW[*],CIDTABLE=CIDROW[*,*]; 02187500
PROCEDURE TERMINALMESSAGA(N); VALUE N; REAL N; 02188000
BEGIN LABEL FOUND,DOIT,OWT,TOIT; 02189000
REAL A,T,S,ADR;% 02190000
NAME B;% 02191000
ARRAY FIB[*]; 02191500
REAL BLEN,NBUF; 02191600
REAL MIXER,TOPIO,LUN,L;% 02192000
INTEGER I=S; LABEL QZ;% 02193000
LABEL STT;% 02194000
SUBROUTINE SLAPITOFF;% 02195000
IF LUN GEQ 32 THEN 02195100
$ SET OMIT = PACKETS 02195199
ELSE 02195300
BEGIN SLEEP([TOGGLE],STATUSMASK); 02196000
READY ~ NOT (I ~ TWO(LUN)) AND READY;% 02197000
RRRMECH ~ NOT I AND RRRMECH OR I AND SAVEWORD;% 02198000
LABELTABLE[LUN] ~ @114;% 02199000
MULTITABLE[LUN] ~ RDCTABLE[LUN] ~ 0;% 02200000
END;% 02201000
LABEL LB,LBI;% 02202000
$ SET OMIT = NOT(NEWLOGGING) 02202049
NOMEM:=NOMEM-TAR[P1MIX].[20:1]; %IF THIS JOB HAD A NOMEM 02202100
TAR[P1MIX].[20:1]:=0; %CONDITION - CLEAR IT 02202200
UNLOCKTOG(TAR[P1MIX]); 02202500
REPLY[P1MIX]~0;% 02203000
PRTROW[P1MIX].[PSF]:=3; % IN PROCESS OF DSING 02205000
PRYOR[P1MIX]~-1; 02205100
A ~ IF N < 0 THEN ABS(N) ELSE SPACE(10);% 02206000
IF N=32 THEN JAR[P1MIX,6].[1;1]~1; % MEM PAR %949-02206100
B ~ PRT[P1MIX,4];% 02207000
IF P(M[L~PRT[P1MIX,8].[CF]],TOP,XCH,DEL)THEN %TR02208000
S~ADR~0 ELSE %TR02209000
DO BEGIN IF P(M[L],TOP,XCH,0,INX,.ADR,~) THEN% OVERLAID RCWTR02210000
BEGIN IF NOT M[L].[33:1] THEN%NOT TYPE 13 INT 02211000
BEGIN S~ADR; %SEGNO IN RCW 02211010
T~0;ADR~M[M[L].MOM].[CF]; % AND THE MSCW %TR02212000
END ELSE S~-1; 02212100
END ELSE % ITS PRESENT: WDVE GOT TO WORK %TR02213000
BEGIN T~0; 02214000
WHILE (S:=M[T].[CF]) LSS ADR DO 02215000
IF S>T THEN T:=S ELSE PUNT(3); 02215500
S~IF M[T].[AREATYPEF]=CODEAREV THEN% %167-02216000
M[T+1].[CF] ELSE 0;% %167-02216010
T~T+2; END; %TR02216100
IF PRT[P1MIX,8].[CF]!L OR M[L-1].MSFF%STACK IS MARKED02216200
THEN DO L~M[L].MOM UNTIL NOT M[L].MSFF;%GET LAST MSCW02216300
L~M[L].MOM;%POINT L TO NEXT RCW,JUST IN CASE. %TR02216400
END UNTIL (IF S!0 THEN IF S=(-1) THEN 0 ELSE 02216500
(B[0]<S OR NOT B[S].PBIT) 02216510
ELSE (P(M[T-2].[3:12],DUP)!@700 AND P(XCH)!@1500)); 02216600
FOUND: ADR ~ ADR-T;% 02217000
T:=PLACEFINDER(S,ADR,S); 02217100
IF N GTR 0 THEN 02217200
BEGIN 02217300
B ~ [M[SPACE(TERMMSGSZ)]]; 02218000
DISKWAIT(-(B INX 0),TERMSGSZ,MESSAGETABLE[1].[22:26]); 02219000
END ELSE N:=0; 02220000
STREAM(Z:=N!0,X:=T,T:=6,J:=JAR[P1MIX,0]], 02221000
P1MIX,INDX~PRT[P1MIX,8] INX NOT 2 INX 0, 02222000
DSZE~IF P(M[P(DUP)+1],TOP) THEN P ELSE P.[8:10], 02222200
TOG~(N=7), Q~[B[N]], A); 02223000
BEGIN CI ~ CI+Z; GO TO L1;% 02224000
DS:=LIT "-"; SI:=Q; 02225000
L: SI:=SI+1; 02226000
IF SC = "8" THEN SI:=SI+1 ELSE 02227000
BEGIN A:=DI; DI:=LOC T; 02228000
DS:=OCT; DI:=A; 02229000
END; 02230000
DS:=T CHR; 02231000
IF TOGGLE THEN GO TO L; 02232000
DS ~ LIT " "; GO TO L2;% 02234000
L1: SI ~ A;% 02235000
IF SC ! "~" THEN% 02236000
BEGIN SI ~ SI+1; A ~ SI;% 02237000
GO TO L1;% 02238000
END;% 02239000
DI ~ A;% 02240000
L2:% 02241000
SI ~ J; SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT "/";% 02242000
SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT "=";% 02243000
SI~LOC P1MIX; DS~2DEC; A~DI; 02244000
DI~DI-2; DS~FILL; DS~A; 02244500
SI:=X; DS:=20 CHR; A:=DI; 02245000
TOG(DI~A; DS~2 LIT ". "; A~DI; SI~INDX; 02251010
SKIP SB; IF SB THEN BEGIN DI~INDX; 02251020
SKIP DB; DS~RESET; DI~A; TOG~TALLY; 02251030
DS~12 LIT "EFF INX IS -"; END; 02251040
A~DI; DI~INDX; DI~LOC Q; DS~8 DEC; 02251050
SI~LOC Q; 7(IF SC>"0" THEN JUMP OUT; 02251060
TALY~TALY+1; SI~SI+1); DI~A; 02251070
T~TALLY; DS~8 CHR; DI~DI-T; 02251080
T(DS~LIT " "); DI~DI-T; A~DI); 02251090
TOG(SI~LOC DSZE; DI~LOC Q; DS~4 DEC; 02251100
DI~A; DS~5 LIT " GEQ "; SI~LOC Q; 02251110
TALLY~0; 3(IF SC>"0" THEN JUMP OUT); 02251120
TALLY~TALLY+1; SI~SI+1); 02251130
T~TALLY; DS~4 CHR; DI~DI-T; 02251140
T(DS~LIT " "); DI~DI-T; A~DI); 02251150
DI ~ A; DS ~ LIT "~";% 02252000
END;% 02253000
IF N!0 THEN FORGETSPACE(B); 02253050
S~A; 02254000
STREAM(B~S,A~A~SPACE(17));% 02255000
BEGIN 17(DS~8 LIT"#"); SI~B;DI~A;DI~DI+8;DS~2 LIT" ";% 02255100
17(8(IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 TO L1)) ; 02255200
L1: DS~2 LIT" ";% 02255500
END;% 02256000
SPOUT(S); 02256500
IF NOT TERMGO THEN BEGIN HALT;% 02257000
COMPLEXSLEEP(-100=NUMESS);% 02258000
DO UNTIL KEYIN(0)=1; 02258100
NOPROCESSTOG ~ NOPROCESSTOG-1; END;% 02258200
JAR[P1MIX,1] ~-JAR[P1MIX,1];% 02259000
UNHOOQUE(P1MIX);% 02260000
MIXER~ @300+P1MIX;% 02261000
IF N=35 THEN % ES-ED 02261050
IF JAR[P1MIX,9].SYSJOBF = PRNPBTCODE THEN 02261100
IF (L:=PRT[P1MIX,@25]) !0 THEN 02261200
BEGIN %675-02261250
IF (LUN~L.[41:5])<16 THEN SLAPITOFF; %675-02261300
LUN~L.[46:2]+19; % LPA, LPB, OR CPA %675-02261350
SLAPITOFF; %675-02261400
END; % PRNPBT/DISK ES-ED: TO CLEAR UNITS. 02261750
STT: T~MSTART;% 02262000
WHILE(L~T.[CF])!0 DO% 02263000
IF (T~M[L]).[3:12]=MIXER AND T>0% 02264000
THEN% 02265000
BEGIN LUN ~ (TOPIO ~ NFLAG(M[L+2])).[12:6]; 02266000
IF LUN }32 THEN 02266100
BEGIN 02266200
FILECLOSE(TOP10 INX 0); 02266300
GO TO STT; 02266400
END; 02266500
IF UNIT[LUN].[13:5] = @20 02267000
THEN BEGIN% 02268000
QZ:% 02269000
SLAPITOFF; 02270000
UNIT[LUN].[13:5]:=@20;% MARK IT NOT READY ANYWAYS 02270500
FORGETSPACE(L INX 2);% 02271000
GO TO STT;% 02272000
END ELSE 02273000
BEGIN T ~ 0; 02274000
FIB ~ M[TOPIO INX NOT 2]; 02275000
ADR ~ NBUF ~ FIB[13].[1:9]-1; 02275100
IF P(M[TOPIO].[3:5],DUP)=22 OR P(XCH)=26 THEN 02275150
BEGIN FOR S ~ 1 STEP 1 UNTIL ADR DO 02275200
TOIT: IF NOT M[TOPIO INX S].[19:1] THEN 02275250
DOIT: IF LUN{18 THEN 02275300
BEGIN M[TOPIO INX S].[20:1] ~ 0; 02275350
M[M[TOPIO INX S] INX 17] ~ M[TOPIO INX S]02275400
& FIB[5] [FTC]; 02275450
FIB[5] ~ P(DUP,LOD,0,1,CFX,+); 02275500
IF NOT PRTROW[P1MIX].[17:1] THEN 02275550
IF FIB[14].[CF]=FIB[14].[FF] THEN 02275600
BEGIN PBIO(TOPIO INX S,FIB[14]); 02275650
SLEEP([M[TOPIO INX S]],IOMASK);02275700
END ELSE 02275750
BEGIN STREAM(C~M[TOPIO INX S], 02275800
Z~FIB[14].[FF]); 02275850
BEGIN SI ~ C; DS ~ 18 WDS; END;02275900
FIB[14].[FF] ~ P(DUP).[FF]-18; 02275950
END; 02276000
END ELSE 02276050
BEGIN IF WAITIO(M[TOPIO INX S],@357,LUN).[45:1]02276100
THEN GO OWT; 02276150
FIB[6] ~ *P(DUP)+1; 02276200
END; 02276250
IF ADR<0 THEN 02276260
BEGIN IF ADR THEN F[17] ~ BLEN; GO OWT; 02276270
END; 02276280
S ~ 0; 02276290
IF FIB[17] < (BLEN~FIB[18].[3:15]) THEN 02276300
BEGIN IF NOT FIB[13] THEN 02276350
FIB[17] ~ *P(DUP)-(FIB[5].[46:2]=3); 02276360
M[TOPIO] ~ FLAG(FIB[16]); 02276370
STREAM(N~FIB[17],D~M[TOPIO].[CF]); 02276400
BEGIN N(DS ~ 8 LIT " "); END; 02276450
ADR ~ -1; GO DOIT; 02276500
END ELSE ADR ~ -2; 02276550
GO TOIT; 02276600
END ELSE 02276700
OWT: FOR NT1 ~ 0 STEP 1 UNTIL NBUF DO 02276750
M[TOPIO INX N[1] ! *P(DUP) OR IOMASK;% 02277000
IF LUN{22 AND LUN}20 OR (LUN{18 AND % LP OR CP BK-UP 02278000
(P(M[TOPIO].[3:5],DUP)=22 OR P(XCH)=10)) 02278100
THEN 02278500
BEGIN IF LUN { 18 THEN % UNIT IS BACKUP 02279000
BEGIN S~17;% 02280000
STREAM(A,D~L+4); 02281000
BEGIN SI~A; DS~17 WDS END;% 02282000
NT4~M[TOPIO INX NOT 2] INX 0;% 02283000
NT1~M[NT4+14];% 02284000
NT2~NT1.[FF]; NT1~NT1.[CF];% 02285000
IF M[TOPIO].[3:5]=22 THEN % NOT CP BK-UP 02285100
IF NT1=NT2-72 THEN% 02286000
BEGIN NT1~M[NT4+5].[FF];% 02287000
M[NT4+5].[FF]~NT1+1;% 02287100
M[NT2+17]~ @154000400200000 &NT1[CTC];% 02287110
M[NT4+14].[FF]~NT2-18;% 02287120
END ELSE% 02287130
IF M[NT2+35].[27:6]=0 THEN M[NT2+35].[28:1]~1; 02287140
FIB[17] ~ -1; 02287200
M[TOPIO] ~ FLAG(FIB[16]&0[20:47:1]&S[8:38:10]); 02287210
END ELSE % 02287230
BEGIN T~(A INX @540000000000000)&17[8:38:10]; %150-02287240
IF SEPARATE THEN T~T&(LUN!22)[32:47:1] %150-02287245
ELSE T~T&(LUN!22)[28:47:1]; 02287250
IF LUN!22 THEN %IF PUNCH FILE, IGNORE 02287254
IF WAITIO(@4002000000,@357,LUN).[45:1] THEN TO QZ; 02287255
T~WAITIO(T,@357,LUN);% 02287260
IF T.[45:1] THEN TO GO QZ;% 02287270
END; 02287280
END ELSE% 02290000
IF LUN=23 OR LUN=24 THEN% 02291000
BEGIN ADR~L+4;% 02292000
LB: IF(T~UNIT[LUN]).[13:5]=25 THEN% 02293000
BEGIN ADR ~ IOQUE[S~T.[FF]].[33:15];% 02294000
STREAM (A~"END":ADR); BEGIN SI ~ ADR;% 02295000
L:SI ~ SI +1; IF SC = " " THEN TO TO L;% 02296000
$ SET OMIT = PACKETS 02296999
$ SET OMIT = NOT(PACKETS) 02297009
DI:=LOC A;DI:=DI+5; IF 3SC=DC THEN TALLY:=0 ELSE 02297010
BEGIN DI~LOC A; DS~4 LIT "PACK"; DI~LOC A; 02297100
SI~SI-3; IF 4SC=DC THEN TALLY~0 ELSE 02297200
TALLY:=1 END; A:= 02297300
$ POP OMIT 02297301
TALLY END; IF P THEN BEGIN% 02298000
RETURNIOSPACE(S); 02300000
UNIT[LUN]~@7777777777% 02301000
END 02302000
ELSE BEGIN M[TOPIO]~M[TOPIO]OR@2004000000; T~0;% 02303000
M[M[TOPIO]]~"END. "&@14[1:43:5]; END;% 02304000
END; 02305000
IF T!0 THEN% 02306000
BEGIN% 02307000
LBI:T~WAITIO(@40000000+ADR,@367,LUN);% 02308000
IF T.[45:1] THEN GO TO QZ;% 02309000
IF T.[42:1] THEN GO TO LB ELSE% 02310000
GO TO LBI% 02311000
END END;% 02312000
IF T=0 THEN 02313000
IF FIB[5].[42:1] 02313500
THEN FORGETSPACE(L INX 2) 02313600
ELSE FILECLOSE(TOPIO INX 0); 02314000
GO TO SIT 02315000
END; END; 02316000
FORGETSPACE(A);% 02317000
T~MSTART;MIXER~@400+P1MIX;% 02318000
WHILE(L~T.[CF])!0 DO% 02319000
IF(T~M[L]).[3:12]=MIXER AND T>0 THEN% 02320000
IF M[M[L+4].[CF]+5].[41:1] THEN FILECLOSE(L+7); 02321000
T~MSART;MIXER~@600+P1MIX;% 02322000
WHILE(L~T.[CF])!0 DO% 02323000
IF(T~M[L]).[3:12]=MIXER AND T>0 THEN% 02324000
IF M[L+7].[41:1] THEN FILECLOSE(M[L+1] INX 3);% 02325000
FOR LUN ~ 0 STEP 1 UNTIL 31 DO% 02326000
IF RDCTABLE[LUN].[6:6] = P1MIX THEN% 02327000
SLAPITOFF;% 02328000
PRT[P1MIX,8]:=T:=NFO[(P1MIX-1)|NDX+2]INX 2; 02328100
M[T]:=-FLAG(0);M[T-1]:=-FLAG(0&(PRT)[6:33:9]); 02328200
P(.COM5); GO TO DIFFCOM; 02329000
END;% 02330000
SAVE PROCEDURE TERMINALMESSAGE(N); VALUE N; REAL N; 02330100
BEGIN NT1 ~ N; 02330200
P(0,STF); 02330300
TERMINALMESSAGE(NT1); 02330400
END; 02330500
$ SET OMIT = NOT(DEBUGGING OR CHECKLINK) 02330599
ARRAY UNITCODE[*]; 02347100
INTEGER PSEUDOCOPY;% USED BY STARTADECK TO EXERCISE SOME CONTROL %541-02347110
% OVER THE NO. OF "COPIES" OF CONTROLCARD %541-02347120
% SERVICING PSEUDO-READERS. %541-02347130
BOOLEAN PROCEDURE READEMFROMDISK(H,IB); 02347150
VALUE H,IB; ARRAY H[*],IB[*]; FORWARD; 02347160
$ SET OMIT = NOT(PACKETS) 02347199
PROCEDURE DRAINO(UNIT,BUMP,ERROR); 02347200
VALUE UNIT,BUMP,ERROR; REAL UNIT; BOOLEAN BUMP,ERROR; 02347210
BEGIN REAL T; 02347220
LABEL NEXT; 02347222
UNIT~UNIT-32; 02347230
IF BUMP THEN 02347240
PACKETACK[UNIT]:=PACKETACT[UNIT]-1; 02347250
IF ERROR THEN PACKETERR[UNIT]:=TRUE; 02347260
IF PACKETACT[UNIT]=0 THEN 02347280
IF LABELTABLE[UNIT+32]}0 THEN 02347290
IF CIDTAABLE[UNIT,3]<CIDTABLE[UNIT,7] THEN 02347300
BEGIN 02347310
LABELTABLE[UNIT+32]~-@14; 02347315
T~SPACE(13)+2; M[T-4].[9:6]~0; 02347320
M[T INX 10]~UNITCODE[UNIT+9]; 02347325
NEXT: DO UNTIL READEMFROMDISK(CIDROW[UNIT], 02347330
[M[T]]&10[8:38:10]); 02347335
IF PACKETERR[UNIT] THEN BEGIN; 02347340
STREAM(E~"END": Q~@14,D~T); 02347350
BEGIN SI~LOC Q; SI~SI+7; IF SC!DC THEN DI~DI+1; 02347360
Q~DI; S1~Q; 02347370
L: IF SC=" " THEN BEGIN SI~SI+1; GO TO L END; 02347380
DI~LOC E; DI~DI+5; IF 3 SC!DC THEN TALLY+1; 02347390
E~TALLY; END; 02347400
IF P THEN GO TO NEXT; END; 02347410
INDEPENDENTRUNNER(P(.CONTROLCARD),T&(UNIT+32)[2:42:6] 02347430
&ERROR[1:1:1],192); 02347435
PSEUDOCOPY~PSEUDOCOPY+1;% %541-02347437
END ELSE 02347440
ENDOFDECK(UNIT,(UNIT+32)&ERROR[1:1:1]); 02347450
END DRAINO; 02347460
$ POP OMIT 02347461
REAL PROCEDURE UNITIN(TINU,WHAT); VALUE WHAT; REAL WHAT; 02348000
ARRAY TINU[*]; 02348500
BEGIN REAL HOLD; INTEGER T;% 02349000
STREAM(A~0:WHAT);% 02350000
BEGIN SI ~ WHAT;% 02351000
L: IF SC = " " THEN 02352000
BEGIN SI ~ SI + 1; GO TO L; END;% 02353000
DI ~ LOC A; DI ~ DI + 5; DS ~ 3 CHR;% 02353500
END STREAM;% 02354000
HOLD ~ POLISH;% 02355000
$ SET OMIT = NOT(SHAREDISK) 02355999
$ SET OMIT = SHAREDISK 02356499
FOR I~0 STEP 1 UNTIL 64 DO 02356500
$ POP OMIT 02356501
IF TINU[I].[30:18]=HOLD.[30:18] THEN 02357000
BEGIN 02357500
HOLD~I; 02357600
I~70; 02357700
END; 02357800
UNIT~IF I<70 THEN 69 ELSE HOLD; 02358000
END UNITIN; 02359000
PROCEDURE IDLETIME;% 02360000
BEGIN REAL C,N;% 02361000
INTEGER T;% 02362000
HALT;% 02363000
C ~ ((P2MIX}0)+1)|(CLOCK+P(RTR));% 02364000
FOR T ~ 1 STEP 1 UNTIL MIXMAX DO% 02365000
IF JAR[T,*] ! 0 THEN% 02366000
BEGIN N ~ N+1;% 02367000
C ~ -JAR[T,3]-PROCTIME[T]+C; 02368000
END;% 02369000
IF N ! 0 THEN% 02370000
T ~ (C-OLDIDLETIME)/N);% 02371000
OLDIDLETIME ~ C;% 02372000
FOR N ~ 1 STEP 1 UNTIL MIXMAX DO% 02373000
IF JAR[N,*] ! 0 THEN% 02374000
JAR[N,7] ~ *P(DUP)+T;% 02375000
NOPROCESSTOG ~ NOPROCESSTOG-1;% 02376000
END;% 02377000
DEFINE ENTERUSERFILE(ENTERUSEFILE1,ENTERUSERFILE2,ENTERUSERFILE3)= 02378000
P(EUF(ENTERUSERFILE1,ENTERUSERFILE2,ENTERUSERFILE3),DEL);% 02378500
REAL PROCEDURE FUF(A,B,L); VALUE A,B,L; REAL A,B,L; FORWARD; 02379000
INTEGER PROCEDURE CALCULATEPURGE(PURGE);% 02380000
VALUE PURGE; REAL PURGE;% 02381000
BEGIN REAL Y,D;% 02382000
REAL J;% 02383000
REAL C=+1;;% 02384000
STREAM(A~[DATE],B~[Y]);% 02385000
BEGIN S1~A; SI~SI+3; DS ~ 2 OCT; DS ~ 3 OCT END;% 02386000
J ~ (D ~ ( Y+3) DIV 4|1461+(Y+3) MOD 4 | 365 +D+PURGE-% 02387000
1) DIV 1461;% 02388000
IF (Y ~ (D ~ D MOD 1461) DIV 365) = 4 THEN% 02389000
BEGIN Y ~ 3; D ~ 365 END ELSE D ~ D MOD 365;% 02390000
CALCULATEPURGE ~ (4|J+Y-3)|1000+D+1;% 02391000
STREAM(C~[C]); BEGIN SI~C; DS ~ 8 DEC END;% 02392000
END;% 02393000
PROCEDURE CHANGEDATE(BUFF); VALUE BUFF; REAL BUFF; FORWARD; 02393100
DEFINE MIDNIGHT = BEGIN XCLCK:=XCLOCK-WITCHINGHOUR; 02393200
DATE:=CALCULATEPURGE(1); 02393225
CHANGEDATE(SPACE(10)); 02393250
END#; 02393300
REAL PROCEDURE TAPELABEL(M,F,R,C,P); VALUE M,F,R,C,P; %AI02393400
REAL M,F,R,C,P; FORWARD; %AI02393500
$ SET OMIT = NOT (DUMP OR DEBUGGING OR BREAKOUT) 02393790
REAL MFMASK; 02393800
$ POP OMIT 02393810
$ SET OMIT = NOT DEBUGGING %763-02393999
$ SET OMIT = NOT (DEUBGGING OR DUMP) %763-02434051
PROCEDURE DUMPCODE(BUFF); %AI02434100
VALUE BUFF; REAL BUFF; %AI02434110
BEGIN REAL B,S,N,TM,TA,U,D; %AI02434120
INTEGER I; REAL MASK,PARITY; 02434125
ARRAY TP[*]; ARRAY TL[*]; %AI02434130
LABEL X,L1,ERR; 02434135
SUBROUTINE CHECK; 02434162
BEGIN 02434164
IF P(XCH)=@20 THEN 02434166
BEGIN 02434168
STREAM(B~BUFF~BUFF.[15:15]-1); 02434170
DS~32LIT"-DPMT ABORTED, TRY ANOTHER TAPE~"; 02434172
P(WAITIO(@4740000020,@377,U),DEL); % SPACEBACK 02434174
PARITY~1; 02434176
GO ERR; 02434178
END; 02434180
END; 02434182
FOR U~0 STEP 1 UNTIL 15 DO 02434185
IF (MULTITABLE[U] EQV "MEMORY ")=NOT 0 THEN 02434190
IF (LABELTABLE[U].[5:25]="1DUMP") THEN GO L1; 02434195
FOR U~0 STEP 1 UNTIL 15 DO IF LABELTABLE[U]=0 %AI02434200
AND PRNTABLE[U].[1:1] THEN TO GO TO L1; %AI02434210
BUFF:=BUFF.[15:15]-1; %AI02434215
STREAM(BUFF); %AI02434220
DS:=17LIT"#NO MEMDUMP TAPE~"; 02434230
GO TO X; %AI02434240
L1: MULTITABLE[U]:="MEMORY "; %AI02434250
LABELTABLE[U].[1:29]:=@1024644447; %AI02434260
STREAM(A:="001",B:=[LABELTABLE[U]]); %AI02434270
BEGIN SI := LOC A; SI := SI + 5; %AI02434280
DI:=DI+5; DS:=3ADD; %AI02434290
END; %AI02434300
RRRMECH := TWO(U) OR RRRMECH; %AI02434310
B~(SPACE(20))&20[8:38:10]&5[21:45:3]; 02434320
STREAM(LTT~BUFF.[33:15]<100,BUFF~BUFF.[33:15],B); 02434330
BEGIN %AI02434340
DS:=8LIT" "; SI:=B; DS:=19WDS; %AI02434350
DI ~ B; 02434360
LTT(SI ~ LOC BUFF; DS ~ 2 DEC; JUMP OUT 1 TO L);02434365
SI ~ BUFF; 02434367
20(8(IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 %AI02434370
TO L)); L: %AI02434380
END; 02434390
LABELTABLE[U].[1:5]:=@20; %AI02434400
TL:=[M[TAPELABEL("MEMORY ",LABELTABLE[U].[6:42], %AI02434410
1,1,100]]710[8:28:10]&5[21:45:3]; 02434420
STREAM(A~PRNTABLE[U],[30:18],TL); 02434424
BEGIN SI~LOC A; DI~DI+53; DS~5 DEC END; %AI02434426
TP:=[M[TA:=TYPEDSPACE(513,MDUMPAREAV)]]&513[8:38:10]&02434430
5[21:45:3];% %167-02434435
TM:=0&@1737[1:37:11]; %AI02434440
MASK~@40 & @20[CTF]; %AI02434445
S:=0; %AI02434470
HALT; SLEEP([TOGLE],STOREMASK); %AI02434480
LOCKTOG(STOREMASK); 02434490
WHILE (S:=M[S]).[33:15] NEQ 0 DO %AI02434500
IF M[S].[1:17]=@1000 THEN %AI02434510
D:=OLAY(S.[33:15]); %AI02434520
UNLOCKTOG(STOREMASK); 02434530
P(WAITIO(TL,MASK,U),DEL); 02434532
P(WAITIO([TM],MASK,U),DEL); 02434534
S:=0; %AI02434540
DO BEGIN %AI02434550
N:=S.[33:3]; %AI02434560
IF(MEMASK AND TWO(N))NEQ 0 THEN S:=-S 02434570
ELSE MOVE(512,S,TA+1); %AI02434580
TP[0] := S; %AI02434590
P(WAITIO(TP,MASK,U)); CHECK; 02434600
IF S LSS 0 THEN S := 3584 - S; %AI02434610
END UNTIL (S:=S+512).[18:15]; %AI02434620
P(WAITIO(B,MASK,U)); CHECK; 02434630
LABELTABLE[U].[1:5]~@01; %AI02434690
BUFF:=BUFF.[15:15-1; %AI02434695
STREAM(U~TINU[U],L~LABELTABLE[U],BUFF); %AI02434700
BEGIN %AI02434710
SI:=LOC U; SI := SI + 5; %AI02434720
DS:=1LIT" "; DS:=3CHR; %AI02434730
SI~LOC L; SI~SI+1; DS~ 1 LIT " "; DS~7 CHR; %AI02434735
DS:=7LIT" DP-ED~"; %AI02434740
END; %AI02434750
ERR: P(WAITIO([TM],MASK,U),DEL); 02434760
P(WAITIO(TL,MASK,U),DEL); 02434770
IF PARITY HEN SETNOTINUSE(U,1) ELSE 02434780
BEGIN 02434790
P(WAITIO([TM],MASK,U),DEL); 02434800
P(WAITIO(@4740000020,@377,U),DEL); 02434810
END; 02434820
FORGETSPACE(TP); 02434830
FORGETSPACE(TL); 02434840
FORGETSPACE(B); 02434850
NOPROCESSTOG!NOPROCESSTOG-1; 02434860
X: SPOUT(BUFF); 02434870
END DUMPCORE; 02434880
$ POP OMIT 02434890
$ SET OMIT = NOT(DEBUGGING) 02434999
$ SET OMIT = NOT(DATACOM AND DCSPO ) 02522099
PROCEDURE NAMEIO(A,KTR);% 02603000
REAL A,KTR;% 02604000
BEGIN;% 02605000
STREAM(A~[A]:KTR);% 02606000
BEGIN DI ~ A; DS ~ 8 LIT "0 ";% 02607000
DI ~ DI-7; SI ~ KTR;% 02608000
L: IF SC = " " THEN% 02609000
BEGIN SI ~ SI+1; GO TO L END;% 02610000
IF SC = """ THEN% 02611000
BEGIN SI ~ SI+1;% 02612000
7(IF SC = "~" THEN JUMP OUT TO EXIT;% 02613000
DS ~ CHR;% 02614000
IF SC = """ THEN JUMP OUT TO LQ;);% 02615000
LS: IF SC ! """ THEN IF SC ! LEFTARROW THEN %152-02615100
BEGIN SI := SI + 1; GO TO LS; END; %152-02615200
IF SC = LEFTARROW THEN GO TO EXIT; %152-02615300
LQ: SI ~ SI+1;% 02616000
GO TO EXIT;% 02617000
END;% 02618000
IF SC = ALPHA THEN% 02619000
BEGIN 7(DS ~ CHR;% 02620000
IF SC = ALPHA THEN GO TO LA;% 02621000
JUMP OUT TO EXIT;% 02622000
LA: );% 02623000
LE: IF SC = ALPHA THEN % 02623500
BEGIN SI~SI+1; GO TO LE; END; % 02623501
GO TO FIXIT;% 02624000
END;% 02625000
IF SC = "~" THEN% 02626000
BEGIN DS ~ CHR; SI ~ SI-1; GO TO EXIT END;% 02627000
IF SC = "=" THEN% 02628000
BEGIN DS~2 LIT"~~"; SI~SI+1; GO TO EXIT END; 02629000
DS ~ CHR;% 02630000
EXIT:A ! SI;% 02631000
END;% 02632000
KTR ~ P(XCH);% 02633000
END;% 02634000
REAL PROCEDURE TAPELABEL(MULFID,FID,REELNO,CYCLE,PURGE);% 02635000
VALUE MULFID,FID,REELNO,CYCLE,PURGE;% 02636000
REAL MULFID,FID,REELNO,CYCLE,PURGE;% 02637000
BEGIN REAL LBL;% 02638000
LBL:=TYPEDSPACE(10,LABELAREAV);% %167-02639000
STREAM(% 02640000
DATE, MULFID,FID,REELNO,CYCLE,PU~CALCULATEPURGE(PURGE),% 02641000
LBL);% 02642000
BEGIN% 02643000
DS~8 LIT" LABEL ";% 02644000
SI~LOC MULFID;% 02645000
DS~WDS;% 02646000
DS~WDS;% 02647000
DS~3 DEC;% 02648000
SI ~ LOC DATE; SI ~ SI+3;% 02649000
DS ~ 5 CHR;% 02650000
SI~LOC CYCLE;% 02651000
DS~ 2 DEC; 02652000
SI~LOC PU; SI~SI+3;% 02653000
DS~5 CHR; DS~1 LIT"0";% 02654000
5(DS~8 LIT"00000000")% 02655000
END;% 02656000
TAPELABEL~LBL;% 02657000
END;% 02658000
REAL PROCEDURE LABELASCRATCH(LBL); VALUE LBL; REAL LB;% 02659000
BEGIN% 02660000
REAL LUN,TM,REEL,T; 02661000
LBL ~ P(.LBL,LOD).]CF] & 10[8:38:1]; & 02662000
(IF P(.LBL,LOC).[7:1] THEN 1 ELSE 5)[21:45:3]; 02662050
STREAM(L~LBL+3,R~[REEL]); 02662100
BEGIN SI~L; DSD~3 OCT END; 02662200
LUN~FINDOUTPUT(M[LBL+1],M[LBL+2],REEL,0,0,2,0,TM); 02663000
IF LUN}0 THEN 02663100
BEGIN; 02663200
STREAM(A~PRNTABLE[LUN].[30:18]],T~[T],L~LBL+6); 02664000
BEGIN DI~DI+5; SI~LOC A; DS~5DEC; SI~SI-8; DI~T; 02664100
DS~8DEC; DI~DI-7; DS~6FILL; END; 02665000
RDCTABLE[LUN].[8:6]~P1MIX; 02665100
M[LBL+1].[1:5]:=0; %148-02665110
MULTITABLE[LUN]~M[LBL+1]; 02665150
RRRMECH~TWO(LUN) OR RRRMECH; 02665200
P(WAITIO(LBL,0,LUN),DEL); 02666000
TM~0&"}~"[1:37:11];% 02667000
P(WAITIO([TM],0,LUN),DEL);% 02668000
$ SET OMIT = PACKETS 02668099
FILEMESSAGE(" OUT"&TINU[LUN][6:30:18],T, 02668500
M[LBL+1],M[LBL+2],REEL,0,0,OPNMESS); 02668600
END; 02668800
LABELASCRATCH~LUN% 02669000
END LABELASCRATCH;% 02670000
PROCEDURE NSECOND;FORWARD;% 02692000
DEFINE CHECKSTACKSPACE = IF P(PRT[P1MIX,*] INX 0)-P(0,RDS)<128 %WF 02693000
THEN BEGIN P(64,STS); GO TO STACKOVERFLOW; END#; %WF 02694000
ARRAY USERCODE[*]; 02695000
REAL PROCEDURE SECURITYCHECK(M,F,U,H); 02696000
VALUE M,F,U; REAL M,F,U,H; FORWARD; 02696100
PROCEDURE MAKEPRESENT(C); VALUE C; REAL C; FORWARD; 02696200
PROCEDURE SIGNOFF(V,F,W);VALUE V,F,W;ARRAY V[*],F[*];REAL W;FORWARD; 02696300
SAVE PROCEDURE IOREQUEST(F,I,L); VALUE F,I,L; ARRAY F,L[*]; REAL I; 02696500
FORWARD; 02696600
BOOLEAN PROCEDURE MTXIN(I,UMB); REAL U,B; INTEGER I; FORWARD; 02696700
$ SET OMIT = NOT(BREAKOUT AND AUXMEM) 02697299
DEFINE CODEADDRESS(CODEADDRESS1,CODEADDRESS2)= 02697710
ACTUALOVERLAYADDRESS(1,CODEADDRESS1,CODEADDRESS2)#, 02697720
DATAADDRESS(DATAADDRESS1,DATAADDRESS2)= 02697730
ACTUALOVERLAYADDRESS(0,DATAADDRESS1,DATAADDRESS2)#; 02697740
SAVE INTEGER PROCEDURE ACTUALOVERLAYADDRESS(TYPE,MIX,LOC); 02697750
VALUE TYPE,MIX,LOC); INTEGER TYPE,MIX,LOC; FORWARD; 02697770
$ SET OMIT = NOT(BREAKOUT) 02700000
$ SET OMIT = NOT(DATACOM AND DCSPO ) 03500099
SAVE PROCEDURE INITIATEIO(IODESC,MIX,U);% 04000000
VALUE IODESC,MIX,U;% 04001000
REAL MIX,U;% 04002000
REAL IODESC;% 04003000
BEGIN REAL C=+1;LABEL EXIT; 04004000
$ SET OMIT = NOT(STATISTICS) 04004099
IF (P(IODESC.[3:5] %204-04004110
$SET OMIT = DKBNODFX %204-04004119
,DUP)= @14 OR P(XCH %204-04004120
$ POP OMIT %204-04004121
) = @6) AND %204-04004130
NOT IODESC.[24:1] AND %204-04004140
(((P(M[IODESC.[CF]],DUP) EQV 0)=NOT 0) OR %204-04004150
((P(XCH) EQV 32)=NOT 0)) AND %204-04004155
NOT OKSEGZEROWRITE THEN %204-04004160
BYBY("SEGMENT ZERO OVERWRITE~",23); %204-04004170
P(TIO); 04004200
CHANNEL[P(DUP)]*U; 04005000
P([IODESC],TIO); 04006000
CNANIO[C]~CLOCK+P(RTR); 04007000
$ SET OMIT = NOT(STATISTICS AND AUXMEM) 04007099
IF U < 16 THEN 04008000
BEGIN 04008100
IF IODESC.[22:1] THEN% 04009000
BEGIN TRANSACTION[U] ! IF IODESC.[18:1] THEN 0% 04010000
ELSE TRANSACTION[U]-1;% 04011000
GO TO EXIT;% 04012000
END; 04013000
$ SET OMIT = NOT(STATISTICS) 04013009
END 04013100
ELSE 04013200
IF (U OR 1)=19 THEN 04013300
BEGIN 04014000
FUIO[C]~CLOCK+P(RTR); 04014002
$ SET OMIT = NOT(STATISTICS) 04014009
END; 04014100
$ RESET OMIT 04014105
TRANSACTION[U] := P(DUP,LOD)+1; 04014500
EXIT:END;% 04015000
SAVE PROCEDURE QUEUEUP(U); VALUE U; REAL U;% 04016000
BEGIN IF U=30 THEN 04016100
WAITQUE[FIRSTWAIT:=(FIRSTWAIT+31) AND 31]:=U ELSE 04016200
BEGIN WAITQUE[NEXTWAIT] ~ U;% 04017000
NEXTWAIT ~ NEXTWAIT+1 AND 31;% 04018000
END;% 04019000
END; 04019100
$ SET OMIT = NOT(DFX) 04019499
SAVE PROCEDURE STARTIO(U); VALUE U; REAL U; 04020000
BEGIN REAL T=NT1,R=NT2, S=NT3;% 04021000
$ SET OMIT = NOT(DFX) 04021099
IF (T ~ UNIT[U]).[13:5] = 0 THEN% 04022000
IF (S ~ T.[18:15]) < @1777 THEN% 04023000
$ SET OMIT = NOT(DFX) 04023099
BEGIN IF P(TIO) ! 0 THEN% 04024000
BEGIN INITIATEIO(IOQUE[S],LOCATQUE[X].[3:5]04025000
,U);% 04026000
P(3);% 04027000
END% 04028000
ELSE BEGIN QUEUEUP(U);% 04029000
P(4);% 04030000
END;% 04031000
P(T&P(XCH)[15:45:3],UNIT[U],~);% 04032000
$ SET OMIT = DFX 04032999
END;% 04033000
$ POP OMIT 04033001
$ SET OMIT = NOT(DFX) 04033049
END;% 04034000
SAVE PROCEDURE PRINTERFINISHED(U); VALUE U; REAL U;% 04035000
BEGIN 04036000
$ SET OMIT = NOT(NEWLOGGING) 04036099
IF NOT UNIT[U].[16:1] THEN UNIT[U].[17:1] ~ 0; 04036200
STARTIO(U);% 04037000
GO TO EXTERNAL;% 04038000
END;% 04039000
SAVE PROCEDURE IOREQUEST(FINAL,IODESC,LOCATION);% 04040000
VALUE FINAL,IODESC,LOCATION;% 04041000
ARRAY FINAL,LOCATION[*];% 04042000
REAL IODESC;% 04043000
BEGIN REAL U=NT1,T=NT2,S=NT3,R=+1;% 04044000
$ SET OMIT = NOT(DFX) 04044099
IF IOQUESLOTS LEQ 04045000
(U:=IF LOCATION.[9:1] OR P1MIX=0 THEN 0 ELSE 7) THEN 04045100
SLEEP([IOQUESLOTS],@77-U); 04045200
IOQUEAVAIL ~ IOQUE[S:=IOQUEAVAIL]; 04046000
$ SET OMIT = NOT(STATISTICS) 04047009
$ SET OMIT = NOT(DFX) 04047099
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 04048701
$ SET OMIT = DFX 04048799
IF (T ~ UNIT[U ~ LOCATION.[12:6]]).[13:5] = 0 THEN 04048800
$ POP OMIT 04048801
BEGIN IF P(TIO) ! 0 THEN% 04049000
BEGIN INITIATEIO(IODESC,P1MIX,U);% 04050000
P(3);% 04051000
END ELSE BEGIN QUEUEUP(U);% 04052000
P(4);% 04053000
END;% 04054000
T ~ T&P(XCH)[15:45:3]&S[18:33:15];% 04055000
END ELSE% 04056000
IF T.[18:6] = @77 THEN% 04057000
T.[18:15] ~ S ELSE% 04058000
LOCATQUE[P(T.[33:15],DUP)]~LOCATQUE[R]&% 04059000
S[18:33:15];% 04060000
$ SET OMIT = NOT(DFX) 04060099
IOQUESLOTS:=IOQUESLOTS-1; 04060500
LOCATQUE[S] ~ LOCATION&P1MIX[3:43:5] OR @7777700000;% 04061000
$ SET OMIT = DFX 04061999
UNIT[U] ~ T&S[33:33:15];% 04062000
$ POP OMIT 04062001
IOQUE[S] ~ IODESC;% 04063000
FINALQUE[S] ~ FINAL;% 04064000
END;% 04065000
SAVE PROCEDURE FINISHOFFIO(U); VALUE U; REAL U;% 04067000
BEGIN REAL T=NT1, FIN=NT3, V=NT4, IOD=NT6; 04068000
LABEL ON,OFF,C0,C1,C2,C3,C4,C5,C6,C7;% 04069000
SWITCH CSW ~ C0,C1,C2,C3,C4,C5,C6,C7;% 04070000
IF FIN > 0 THEN% 04071000
IF FIN.[25:1] THEN% 04072000
BEGIN T ~ FIN.[3:5];% 04073000
FIN ~ FIN&IOD[3:3:5]&0[25:25:1];% 04074000
GO TO CSW[T];% 04075000
END ELSE GO ON ELSE GO ON;% 04076000
C0: GO TO C0;% 04077000
C1: FIN.[8:10] ~ V;% 04078000
GO TO C2;% 04079000
C3: FIN.[8:10] ~ V;% 04080000
C4: FIN ~ NOT V INX 1 INX FIN;% 04081000
GO TO C5;% 04082000
C6: STREAM(A~0:IOD);% 04083000
BEGIN DI ~ LOC A; SI ~ IOD; SI ~ SI+4; DS~4 OCT END; 04084000
T ~ P DIV 8-1;% 04085000
OFF: FIN.[8:10] ~ T;% 04086000
GO TO C2;% 04087000
C7: STREAM(A~0:IOD);% 04088000
BEGIN DI ~ LOC A; SI ~ IOD; DS ~ 4 OCT END;% 04089000
T ~ P DIV 8-1;% 04090000
FIN ~ (NOT T INX 1 INX FIN)&T[8:38:10];% 04091000
GO TO C5;% 04092000
ON: IF U < 16 THEN% 04093000
IF IOD.[22:1] THEN% 04094000
C5: M[IOD INX 1] ~ M[NOT V INX IOD INX 1] ~ V% 04095000
ELSE% 04096000
C2: M[IOD INX NOT 0] ~ V;% 04097000
END;% 04098000
PROCEDURE PROGRAMRELEASE;% 04099000
BEGIN NAME T; REAL FSX=JUNK; 04100000
ARRAY R=-4[*];% 04101000
REAL IOD=NT1;% 04102000
ARRAY LOCN[*];% 04103000
REAL S; 04103050
CHECKSTACKSPACE;% %WF 04103100
LOCN~M[S~(IF(IOD~NFLAG(M[P(T~[M[PRT[P1MIX,9]]],DUP,PRL)])) 04104000
.[22:1] THEN 2 ELSE NOT 1) INX IOD); 04105000
IF IOD.[3:5]= 6 THEN 04105100
BEGIN; STREAM(S:=M[PRT[P1MIX,8]] INX P(DUP,0,XCH,DIA 10, 04105200
DIB 30,TRB 2),D~@600005); 04105300
BEGIN SI~S; DS~2 CHR END; 04105400
$ SET OMIT = NOT(STATISTICS) 04105409
IF JUNK.[36:12]!45 AND RELTOG 04105500
OR M[IOD].[3:6] = 0 AND M[IOD] LSS (DIRDSK | DSKTOG) THEN 04105510
IF (USERCODE[P1MIX] EQV MCP) ! NOT 0 THEN % 04105550
BEGIN TERMINATE(P1MIX); TERMINALMESSAGE(30) END; 04105600
IF(FS[P1MIX,(FSX~P(*(NOT 2 INX LOCN),4,COC).[13:11] 04105650
DIV 5).[40:4]] 04105700
AND TWO(IOD.[24:1]&FSX[43:44:4]))!0 THEN 04105750
BEGIN T[0]:=T[0]&1[19:47:1]&0[26:40:7]; 04105800
M[(*((NOT 2)INX LOCN))INX 5 ]:= NABS(*P(DUP)); 04105850
GO TO RETURN; 04105890
END; 04105900
IF NOT IOD.[24:1] THEN M[S].[11:1]~1; 04105950
END DISK BUSINESS; 04105990
IF IOD.[3:5]=30 THEN GO RETURN; % SPO %846-04105998
IOREQUEST(R,IOD,LOCN);% 04106000
T[0].[19:1] ~ 0; 04107000
IF (NT1~P(*(NOT 2 INX LOCN),13,COC).[10:9]-1)!0 THEN% 04108000
STREAM(NT1,C~T[0],T); 04109000
BEGIN SI ~ T; SI ~ SI+8; DS ~ NT1 WDS;% 04110000
SI ~ LOC C; DS ~ WDS;% 04111000
END;% 04112000
GO TO RETURN;% 04113000
END;% 04114000
SAVE PROCEDURE NEWIO;% 04115000
BEGIN REAL S=NT3,U=NT4;% 04116000
S ~ UNIT[U~WAITQUE[FIRSTWAIT]].[18:15];% 04117000
INITIATEIO(IOQUE[S],LOCATQUE[S].[3:5],U);% 04118000
FIRSTWAIT ~ FIRSTWAIT+1 AND 31;% 04119000
UNIT[U].[13:5] ~ 3;% 04120000
END;% 04121000
REAL MDELTA = @11;% 04121050
REAL MLOG = @12;% 04121100
REAL MROW = @13;% 04121150
REAL LOGSIZE = @43;% 04121170
REAL LOGHOLDER = @56;% 04121200
REAL NUMAINTMESS = @57;% 04121250
REAL LOGENTRY = @63;% 04121300
REAL NXDISK = @76;% 04121350
ARRAY MAINTLOGARRAY = @77[*];% 04121400
PROCEDURE DISKORAUXERROR(R); VALUE R; REAL R; FORWARD; 04121410
PROCEDURE ACTUALIOERR(R); VALUE R; REAL R; FORWARD; 04121425
PROCEDURE LINKUP(TYPE,KEY); VALUE TYPE,KEY; REAL TYPE,KEY; FORWARD;% 04121450
PROCEDURE CHECKJOBORFILEMESS(MIX,FIB,U);% 04121500
VALUE MIX,FIB,U; REAL MIX,FIB,U; FORWARD;% 04121550
PROCEDURE LOGOUTMAINT(B); VALUE B; REAL B; FORWARD;% 04121600
PROCEDURE MAINTLOGGER(B); VALUE B; REAL B; FORWARD;% 04121650
DEFINE 04121700
LOGVERSION=( % VERSION NUMBER ON NEXT CARD 04121710
2 04121720
& % CURRENT ENTRIES ON NEXT CARD 04121730
21 04121740
[30:42:6])#, 04121750
TAPEBUFFERSIZE = 200#; 04121850
ARRAY MAINTBUFFER[*]; 04121950
SAVE PROCEDURE IOFINISH(C,R); VALUE R,C; REAL R,C; 04122000
BEGIN BOOLEAN STOP; 04123000
COMMENT 04123010
WHEN E!0, STOP TAKES THE FOLLOWING VALUES: 04123020
0 DISK ERROR (OTHER THAN NOT READY ON A DFX SYSTEM). 04123030
1 ANY ERROR OTHER THAN THOSE LISTED FOR 0, 2 OR 3. 04123040
2 LOCKED ADDRESS (SHAREDISK). 04123050
3 ANY ERROR OCCURRING WHEN UNIT[U].[5:8]!0 (A RETRY). 04123060
WHEN E=0, STOP TAKES THESE VALUES: 04123070
-2 IO FOR WHICH COMPLETE SHOULD NOT BE SET (DATACOM OR 04123080
DISK WRITE BEFORE READ WITH UNIT OR EU SWITCH). 04123090
1 PRINTER IO. 04123100
0 NORMAL IO. 04123110
END COMMENT; 04123120
REAL TIM=STOP+1, U=TIM+1; 04123500
LABEL TEST,NOWAIT,PROC,NEW,QUP,INCR; 04124000
LABEL ERRORS,DISKERR,DS,X,SW,LP,DK,DX,DX1,DC,OK,L1; %111-04125000
REAL T=NT1,S=NT2,S1=NT3,V=NT4,E=NT5,I=NT7;% 04126000
NAME LOCN=E; REAL IOD=NT6, FIN=S1; 04127000
SWITCH TYPE := OK,LP,OK,OK,DK,OK,OK,OK,OK,OK,DC; %111-04128000
04128010
$ SET OMIT = NOT(DFX) 04128099
$ SET OMIT = NOT(NEWLOGGING) 04128799
P(CHANIO[C]); % INITIALIZES TIM04128900
S:=(T:=UNIT[P(CHANNEL[C],DUP)]).[18:15]; % INITIALIZES U 04129000
$ SET OMIT = NOT SEPTICTANK 04129490
% %111-04129520
% CHECK FOR A PARTIAL WORD BINARY READ WITH NO PARITY ERRORS. THIS IS 04129530
% ILLEGAL AND IS MARKED AS BEING A PARITY ERROR. %111-04129540
% %111-04129550
IF U LEQ 15 THEN % TAPE I/O %111-04129560
IF (R.[18:12] AND @4462) = @0440 THEN % BIN READ-NO PAR %111-04129570
IF R.[15:3] ! ((8-R.[22:1]) AND 7) THEN % PART WD XFER%111-04129580
R.[28:1] := MOD3IOS; % MARK AS PARITY ERROR IF MOD III I/04129590
ERRORS: 04129900
IF (E ~ R.[26:7])+(V ~ T.[5:8] ) ! 0 THEN% 04130000
BEGIN IF(S1 ~ FINALQUE[S]) < 0 THEN% 04131000
IF (E ~ S1.[25:8] AND E) = 0 THEN% 04132000
IF V = 0 THEN 04133000
GO TO SW; 04133100
IF (U AND @774) ! 16 THEN 04134000
BEGIN 04134050
RDCTABLE[U]:=(*P(DUP))& (C-1)[1:46:2]& R[3:3:5];04134060
IF U=30 THEN 04134300
BEGIN 04134400
IF (R.[28:5] AND @25 ! 0 THEN 04134500
BEGIN 04134600
IF ( NOT R.[32:1] AND R.[28:1]) THEN 04134700
GO TO DC; 04134800
GO TO X; 04134900
END 04134950
ELSE GO TO DC; 04134955
END ELSE GO TO X; 04134960
END; 04134990
IF E = 0 THEN 04135000
BEGIN % RECOVERED MASS STORAGE % 04137000
MAINTBUFFER[NXDISK:=NXDISK+4 AND 15] 04137100
:= -0 & U[2:46:2] & LOCATQUE[S][4:3:5] & 04137110
(LOIGENTRY:=LOGENTRY+1)[CTF] & 04137120
RDCTABLE[U]{18:1:2]; 04137130
IF FINALQUE[S] GTR 0 THEN 04137140
BEGIN 04137150
MAINTBUFFER[XNDISK]:=(*P(DUP)) & 04137160
((M[M[S1:=LOCATQUE[S] INX NOT 2] INX 4]04137170
.[13:11] DIV ETRLNG)+1)[9:39:9]; 04137180
M[S1].[7:1] := 1; 04137190
END; 04137200
P(MAINTBUFFER[NXDISK+2]:=IOQUE[S]); 04137202
$ SET OMIT = NOT(AUXMEM) 04137203
P(NFLAG(M[P])); 04137212
P(P&V[1:44:4],[MAINTBUFFER[NXDISK+1]],STD); 04137215
MAINTBUFFER[NXDISK+3]:=MAINTBUFFER[U]; 04137220
IF (LOGHOLDER INX 0) = 0 THEN 04137230
BEGIN 04137240
LOGHOLDER.[CF]:=[MAINTBUFFER[NXDISK]]; 04137250
INDEPENDENTRUNNER(P(.MAINTLOGGER),0,100); 04137260
END ELSE M[LOGHOLDER.[FF]].[CF]:= 04137270
[MAINTBUFFER[NXDISK]]; 04137275
LOGHOLDER.[FF]:=[MAINTBUFFER[NXDISK]]; 04137280
NUMAINTMESS:= NUMAINTMESS+1; 04137290
T.[5:8] ~ 0; 04142000
GO TO SW; 04142500
END;% 04143000
IF V = 0 THEN% 04144000
$ SET OMIT = NOT(SHAREDISK) 04144099
BEGIN % ORIGINAL ERROR ON MASS STORAGE% 04145000
TINU[U].[18:2] ~ P(DUP).[18:12]+1;% 04146000
MAINTBUFFER[U]:=R&TWO(C)[18:43:4]; 04146100
RDCTABLE[U]:=(*P(DUP))&(C-1)[1:46:2]; 04146200
V:=129; 04147000
$ SET OMIT = NOT(SHAREDISK) 04147399
END% 04148000
ELSE BEGIN % RECURRENT ERROR ON MASS STORAGE% 04149000
P(MAINTBUFFER[U]:=P(DUP,LOD) OR 04150100
R&TWO(C)[18:43:4]); 04150200
IF (V ~ V+1) > 137 THEN% 04151000
BEGIN R:=P; 04151200
IF LOCATQUE[S].[9:1] THEN % OLAY I/O 04151220
M[LOCATQUE[S]:=R OR IOMASK; 04151230
$ SET OMIT = NOT(AUXMEM) 04151235
DISKERR: 04151300
$ SET OMIT = NOT(DFX) 04151399
T.[5:10]:=0; 04151400
GO TO DX; 04152600
END; 04152800
P(DEL); 04152900
END;% 04153000
UNIT[U] ~ T&V[5:40:8];% 04154000
DS:% 04155000
CHANNEL[P(TIO)] ~ U;% 04156000
P([IOQUE[S]],IIO);% 04157000
GO TO EXTERNAL ;% 04158000
X: STOP ~ (V!0)|2+1;% 04159000
T.[5:13] ~ 32|E+8;% 04160000
GO TO TEST; 04161000
END; 04161500
SW:: GO TO TYPE[T.[1:4]];% 04162000
LP: 04163000
IF STOP := (T := T&0[16:16:1]).[17:1] THEN 04164000
TEST: IF FIRSTWAIT = NEXTWAIT THEN GO TO INCR ELSE% 04165000
GO TO NEW ELSE GO TO NOWAIT;% 04166000
DK: 04167900
IF NOT (I:=IOQUE[S]).[24:1] THEN 04168000
IF FINALQUE[S].[24:1] THEN% 04169000
$ SET OMIT = DFX 04169090
BEGIN 04169100
$ SET OMIT = NOT DKBNODFX OR OMIT 04169190
$ SET OMIT = DKBNODFX OR OMIT 04170750
M[IOQUE[S]:=I&1[24:47:1]]:=*(P(DUP) INX P(0,LNG,XCH)); 04170800
$ POP OMIT 04170900
GO TO DS; 04171000
END ELSE GO TO OK ELSE GO TO OK; 04171200
$ POP OMIT 04171250
$ SET OMIT = NOT DFX 04171350
DC: 04174000
$ SET OMIT = NOT(DATACOM ) 04174999
04176000
$ SET OMIT = DFX 04176899
DX: DX1: 04176900
$ POP OMIT 04176901
OK: IF FIRSTWAIT = NEXTWAIT THEN 04177000
NOWAIT: IF (S1 := LOCATQUE[S].[18:15]) LSS @1777 THEN 04178000
INITIATEIO(IOQUE[S1],LOCATQUE[S1].[3:5],U)% 04180000
ELSE 04181000
PROC: T := T&0[16:16:2] 04182000
ELSE 04183000
BEGIN% 04187000
NEW: NEWIO;% 04188000
IF STOP THEN GO TO INCR;% 04189000
QUP: IF LOCATQUE[S].[FF] GTR @1777 THEN GO TO PROC; 04190000
QUEUEUP(U);% 04191000
T ~ T&4[13:43:5];% 04192000
END;% 04193000
INCR: 04194000
IF (TIM~CLOCK+P(RTR)-TIM) LSS THEN THEN TIM~0; 04194050
IOD:=IOQUE[S]; 04194100
IF (U OR 1 )=19 THEN 04194200
BEGIN 04194300
IF (JUNK:=M[IOD].[5:7])>9 THEN 04194400
JUNK:=NEUP.[CF]+(JUNK AND @17); 04194500
IF JUNK<NEUP.[FF] THEN 04194550
PEUIO[JUNK]:=P(DUP,LOD)+CLOCK+P(RTR)-EUIO[C]; 04194600
END; 04194650
I~(S1~LOCATQUE[S]).[3:5]; % FIND MIX INDEX 04194700
$ SET OMIT = NOT(NEWLOGGING) 04194799
IOTIME[I]~(*P(DUP))+TIM; 04195000
IF P(.S1,LOD).[10:1] THEN FORGETSPACE(IOD); % NO MEM MESSAGE 04195100
IF F!0 THEN 04196200
IF STOP THEN 04196400
P(T) 04196600
ELSE GO TO L1 04196800
ELSE BEGIN 04197000
RETURNIOSPACE(S); 04199000
L1: P(T&P(.L1,LOD)[FTF]); 04201000
END; 04202000
P([UNIT[U]],STD); 04203000
FIN ~ FINALQUE[S] AND NOT MEMORY;% 04205000
IF (U OR 1) NEQ 17 THEN 04205012
IF IOD.[24:1] THEN% 04206000
BEGIN V ~ ABS(IOD.[33:15]-R.[33:15]);% 04207000
IF IOD.[8:10] < V THEN% 04208000
IF IOD.[23:1] THEN% 04209000
V ~ IOD.[8:10];% 04210000
IF U < 16 THEN% 04211000
IF IOD.[21:2] = 0 THEN% 04212000
BEGIN; STREAM(A!0:B~M[S1.[33:15]+V-1]);% 04213000
BEGIN SI ~ LOC B;% 04214000
IF SC = "~" THEN TALLY ~ 1;% 04215000
A ~ TALLTY;% 04216000
END;% 04217000
V ~ -P+V;% 04218000
END;% 04219000
IF U ! 30 THEN % NOT DCA 04219100
FINISHOFFIO(U);% 04220000
END;% 04221000
IF E ! 0 THEN% 04222000
$ SET OMIT = NOT(SHAREDISK) 04222499
BEGIN IF STOP LEQ 1 THEN 04223000
BEGIN 04223500
INDEPENDENTRUNNER( 04224000
P(.DISKORAUXERROR)+((U AND @774) NEQ 16), 04224010
R&S[3:43:5],240); 04224100
LOCATQUE[S].[11:1]:=1; 04224500
END 04224750
ELSE IF FIN < 0 THEN P(LOCATQUE[S],R,XCH,~);% 04225000
END% 04226000
$ SET OMIT = NOT(SHAREDISK) 04226499
ELSE BEGIN% 04227000
IF FIN < 0 THEN P(R OR IOMASK,LOCATQUE[S],~)% 04228000
ELSE 04229000
$ SET OMIT = NOT (DATACOM OR DFX OR DKBNODFX) 04229099
BEGIN 04229200
LOCN ~ [M[LOCATQUE[S]]];% 04230000
IOD ~ IOD.[33:15];% 04231000
WHILE LOCN[0].[33:15] ! IOD DO% 04232000
LOCN ~ 1 INX LOCN;% 04233000
LOCN[0] ~ M OR FIN;% 04234000
END END;% 04235000
IF P1MIX = 0 THEN GO TO NOTHINGTODO;% 04236000
IF I = P1MIX THEN GO TO RETURN;% 04237000
GO TO INITIATE;% 04238000
END IOCOMPLETE;% 04239000
SAVE REAL PROCEDURE WAITIO(IOD,MASK,U);% 04240000
VALUE MASK,U,IOD;% 04241000
REAL MASK,U,IOD;% 04242000
BEGIN% 04243000
REAL T; 04243100
DEFINE OCTADE= DS~3 RESET;3(IF SB THEN DS!SET ELSE 04243200
DS~RESET;SKIP SB)#; 04243300
IOD ~ NFLAG(P(.IOD,LOC))&TINU[U][3:3:5];% 04244000
MASK ~ NOT MASK;% 04245000
IOREQUEST(NABS(IOD)&MASK[25:40:8],IOD, 04246000
[IOD]&U[12:42:6]);% 04247000
IOD ~ IOD&0[25:25:8]&0[19:19:1];% 04248000
SLEEP([IOD],IOMASK);% 04249000
IF ((WAITIO~IOD.[26:7]) AND MASK AND MAKS.[18:15])!0 THEN 04250000
BEGIN 04251000
T~SPACE(12); 04251100
STREAM(IOD~IOD.[26:7],MASK~(NOT MASK).[41:7], 04251200
Z~[TINU[U]],T~T); 04251300
BEGIN DS~20 LIT" UNEXP I-O ERROR ON ";SI~Z; 04251400
SI~SI+5;DS~3 CHR;DS~8 LIT":RESULT="; 04251500
SI~LOC IOD;SI~SI+6;SKIP 3 SB;3(OCTADE); 04251600
DS~6 LIT",MASK=" ;SI~SI+6;SKIP 3 SB; 04251700
3(OCTADE);DS~2 LIT".~"; 04251800
END; 04251900
IF P1MIX = 0 THEN BEGIN P(T); PUNT(0) END; 04252000
IF NOTERMSET(P1MIX) THEN 04252100
BEGIN 04252200
TERMINATE(P1MIX&19[18:33:15]); 04252300
IF JAR[P1MIX,9].SYSJOBF THEN %SYSTEM JOB 04252500
BEGIN 04252600
SPOUT(T); 04252700
BLASTQ(U); 04252800
END ELSE 04252900
TERMINALMESSAGE(-T); 04253000
END; 04253100
END; 04253200
END; 04253300
REAL PROCEDURE TAPEPARITYRETRY(R,U,KEY);% 04254000
VALUE R,U,KEY; REAL R,U,KEY; FORWARD; 04255000
REAL PROCEDURE WRITEPARITYREELSWITCH(OIOD,RC); 04255100
VALUE OIOD,REC; REAL OIOD,RC; FORWARD; 04255200
PROCEDURE DISKORAUXERROR(R); VALUE R; REAL R; 04256000
04256200
BEGIN 04256400
REAL MSCW = -2, 04256600
U = +1, 04256800
S = +2, 04257000
E = +3, 04257200
T = +4, 04257400
MK = +5, CELL = MK, 04257600
IOD = +6, 04257800
MIX = +7, 04258000
FIN = +8, PARITY= FIN, 04258200
KEY1 = +9, 04258400
KEY2 = +10, 04258600
DISC = +11, 04258800
MASK = +12, 04259000
AREA = +13, U1 = AREA, 04259200
RLST = +14, MSG = RSLT, 04259400
PRTMAX = +15, T1 = PRTMAX, 04259600
DISKCELL= +16, T2 = DISKCELL, 04259800
TERMNATE = +17, 04260000
OLAYIO = +18, 04260200
DSKADRS = +19; 04260400
04260600
NAME LOCN = +16; 04260800
04261000
LABEL DSIT, START, QUIT, RETRY, KILLL, KILLER; 04261200
$ SET OMIT = NOT(PACKETS) 04261299
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04261300
$ POP OMIT 04261301
04261400
$ SET OMIT = NOT(AUXMEM) 04261600
04271200
SUBROUTINE DISKMESSAGE; 04271400
BEGIN 04271600
STREAM(MSG, MK, A:=TINU[U], MIX, B:=DSKADRS, 04271800
S:=IOQUE[S].[27:6], R, KEY1:=KEY1:=SPACE(10)); 04272000
BEGIN 04272200
SI:= LOC MK; SI:=SI+7; DS:= CHR; 04272400
SI:=SI+5; DS:=3CHR; DS:=LIT" "; 04272600
CI:=CI+MSG; 04272800
GO L0; GO L1; GO L2; GO L3; GO L4; GO L5; GO L6; GO L7; 04273000
L0: DS:= 9LIT"NOT READY"; GO TO MX; 04273200
L1: DS:= 4LIT"BUSY"; GO TO MX; 04273400
L2: DS:= 8LIT"I/O MEM "; 04273600
L3: DS:= 6LIT"PARITY"; GO TO MX; 04273800
L4: DS:=12LIT"I/O INV ADDR"; GO TO MX; 04274000
L5: DS:= 3LIT"EU "; GO TO L0; 04274200
L6: DS:=13LIT"INV DISK ADDR";GO TO MX; 04274400
L7: DS:=10LIT"WRITE LOCK"; 04274600
MX: DS:= 6LIT", MIX="; DS:=2DEC; 04274800
MSG:=DI; DI:=DI-2; DS:=FILL; DI:=MSG; 04275000
DS:=5LIT", DA="; DS:=8CHR; 04275200
DS:=7LIT", SEGS="; DS:=2DEC; 04275400
DS:=4LIT", R="; 04275600
16(DS:=3RESET; 3(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB)); 04275800
SI:=SI-5; DS:=5LIT", IO="; 04276000
IF SB THEN DS:=2LIT"4,"; SKIP SB; 04276200
IF SB THEN DS:=2LIT"3,"; SKIP SB; 04276400
IF SB THEN DS:=2LIT"2,"; SKIP SB; 04276600
IF SB THEN DS:=2LIT"1,"; 04276800
DI:=DI-1; DS:=LIT"~"; 04277000
END STREAM STATEMENT; 04277200
END SUBROUTINE DISKMESSAGE; 04277400
04277600
SUBROUTINE DETAILRECORDENTRY; 04277800
BEGIN 04278000
KEY2 := TYPEDSPACE(6,MAINTBUFFAREAV);% %167-04278200
M[KEY2] := 0 & RDCTABLE[U][18:1:2]; 04278400
IF MIX NEQ 0 THEN 04278600
BEGIN 04278800
M[KEY2] := (*P(DUP)) & MIX[20:43:5] & 04279000
(IF FINALQUE[S] LSS 0 THEN 0 ELSE 04279200
(M[M[LOCATQUE[S] INX NOT 2] INX 4].[13:11] DIV ETRLNG)+1)[9:39:9];04279400
END; 04279600
M[KEY2+1] := TRANSACTION[U]; 04279800
IF NOT DISC THEN 04280000
BEGIN 04280200
STREAM(S:=IOD.[FF], D:=KEY2+2); 04280400
BEGIN 04280600
SI:=LOC S; DS:=8DEC; 04280800
END; 04281000
END 04281200
ELSE M[KEY2+2] := DSKADRS; 04281400
M[KEY2+3] := IOQUE[S]; 04281600
M[KEY2+4] := R & RDCTABLE[U][3:5:5]; 04281800
M[KEY2+5] := IF FINALQUE[S] LSS 0 THEN 0 ELSE LOCATQUE[S] INX NOT 2; 04282000
END DETAILRECORDENTRY; 04282200
04282400
SUBROUTINE FINISHDETAIL; 04282600
BEGIN 04282800
IF MIX NEQ 0 THEN CHECKJOBORFILEMESS(MIX,M[KEY2+5],U); 04283000
LINKUP(4+DISK,KEY2); 04283200
END; 04283400
04283600
P(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); 04283800
04284000
DISC:=(U:=LOCATQUE[S:=R.[3:5]].[12:6]).[46:1]; 04284200
MIX:=LOCATQUE[S].[3:5]; 04284400
IF (OLAYIO := ((FINALQUE[S] LSS 0) AND (LOCATQUE[S].[9:1]))) THEN 04284600
BEGIN 04284800
STREAM(S:=0&FINALQUE[S][CTC]&FINALQUE[S][21:8:12], D:=[DSKADRS]); 04285000
BEGIN 04285200
SI:=LOC S; DS:=8DEC; % DISK ADDRESS IN FINALQUE FOR OLAY I/O 04285400
END; 04285600
END ELSE DSKADRS := M[IOQUE[S]]; 04285800
MK:="*"; MSG:=(-1); 04286000
R:=R&IOQUE[S][3:3:5]; % RESTORE HARDWARE UNIT TYPE 04286200
IOD := IOQUE[S]; 04286400
IF DISC THEN 04286600
BEGIN 04286800
IF R.[30:1] THEN % DISK NOT READY 04287000
BEGIN 04287200
$ SET OMIT = NOT(DFX) 04287400
UNIT[U]:=(*P(DUP))&@77777[5:20:28]; 04295400
MSG:=0; MK:="#"; % NOT READY 04295600
DISKMESSAGE; 04295800
DETAILRECORDENTRY; 04296000
READY := NOT TWO(U) AND READY; 04296200
RRRMECH := NOT TWO(U) AND RRRMECH; 04296400
UNIT[U].[5:10] := 2; 04296600
GO TO KILLL; 04298800
END; % IF NOT READY 04299000
LOCATQUE[S].[FF] := NOT 0; 04299200
IF R.[26:7] NEQ 1 AND NOT OLAYIO THEN % NOT BUSY OR SPECIAL I/O 04299600
BEGIN 04299800
PARITY := (IOD.[24:1] AND (R.[26.7]=16)); % PARITY CONDITION 04300000
IF FINALQUE[S] GTR 0 THEN % OBJECT JOB ERROR 04300200
BEGIN 04300400
IF PARITY THEN GO TO START; % RECOVERABLE ERROR 04300500
DSIT: TERMINATE(MIX&20[CTF]); 04300600
END % OBJECT ERROR 04301000
ELSE 04301200
BEGIN % MCP I/O 04301400
IF MIX NEQ 0 THEN 04301600
BEGIN 04302000
IF JAR[MIX,9].SYSJOBF THEN % "SYSTEM" JOB 04302200
IF PARITY THEN GO TO START; 04302600
% DONT DS LIBMAIN/DISK ON PARITY ERROR 04302800
GO TO DSIT; 04303000
END; % NON-ZERO MIX 04303200
END; % MCP I/O 04303400
END; % NOT BUSY OR SPECIAL I/O 04303600
04303800
START: 04304000
04304200
TRANSACTION[U] := TRANSACTION[U]-1; 04304400
MASK := IF (FIN := FINALQUE[S]) LSS 0 THEN FIN.[25:8] ELSE @377; 04304600
IF (E := R.[25:8] AND MASK) = 0 THEN % ERRORS ARE ACCEPTABLE 04304800
BEGIN % FIX UP IOQUE 04305000
QUIT: 04305200
IF MSG NEQ (-1) AND DISC THEN DISKMESSAGE; 04305400
DETAILRECORDENTRY; 04305600
$ SET OMIT = NOT(AUXMEM); 04305800
RETURNIOSPACE(S); 04309200
04309400
FIN:=FINALQUE[S] AND NOT MEMORY; 04309600
IF (T1:=FIN) LSS 0 THEN % MCP I/O 04309800
BEGIN 04310000
IF NOT OLAYIO THEN % I/O FINISH PLACES RESULT DESC. FOR OLAY04310200
M[LOCATQUE[S]]:=R&E[25:40:8]&IOD[3:3:5] OR IOMASK; 04310400
END % IF MCP I/O 04310600
ELSE 04310800
BEGIN 04311000
IF E NEQ 0 THEN % ERRORS 04311200
BEGIN 04311400
P(.T1,PRL); 04311600
T1 := T1&E[25:40:8]; 04311800
END 04312000
ELSE P(.T1,IOR); 04312200
LOCN := [M[LOCATQUE[S]]]; 04312400
IOD := IOD.[33:15]; 04312600
WHILE LOCN[0].[33:15] NEQ IOD DO LOCN := 1 INX LOCN; 04312800
LOCN[0] := P(.T1,LOD); 04313000
END; 04313200
GO TO KILLL; 04313600
END; 04313800
IF E THEN % BUSY 04314000
BEGIN 04314200
MSG:=1; % BUSY 04314400
RETRY: 04314600
$ SET OMIT = NOT(AUXMEM) 04314790
DISKMESSAGE; 04314820
DETAILRECORDENTRY; 04315000
$ SET OMIT = NOT(AUXMEM) 04315190
T1:=(IF DISC THEN IOQUE[S]&6[3:43:5] ELSE IOQUE[S]; 04315400
RETURNIOSPACE(S); 04315600
04315800
P1MIX:=MIX; 04316000
IF NOT OLAYIO THEN % RETRIES ARE OK 04316400
IOREQUEST(FINALQUE[S], T1, 04316600
(IF DISC THEN LOCATQUE[S]&@22[12:42:6] ELSE 04316800
LOCATQUE[S])); 04317000
P1MIX:=0; 04317200
GO TO KILLER; 04317400
END; % IF BUSY 04317600
IF E.[46:1] THEN % I/O MEMORY PARITY 04317800
BEGIN 04318000
MSG:=2; 04318200
E:=@1537; 04318400
GO TO QUIT; 04318600
END; 04318800
IF E.[41:1] THEN % INVALID ADDRESS 04319000
BEGIN 04319200
MSG:=4; 04319400
E:=@1537; 04319600
GO TO QUIT; 04319800
END; 04320000
$ SET OMIT = NOT(SHAREDISK) 04320200
IF NOT E.[43:1] THEN % NOT PARITY,CHECK DISK ADDRESS 04325400
BEGIN 04325600
STREAM(DA:=MASK:=DSKADRS : EU:=MASK.[6:6], A:=0, 04325800
EUA:=[MULTITABLE[16+2|MAXK.[5:1]]]); 04326000
BEGIN 04326200
SI:=LOC DA; 04326400
IF SC GTR "1" THEN GO TO BAD; 04326600
IF SC LSS "0" THEN GO TO BAD; 04326800
$ SET OMIT = SHAREDISK 04327000
7( 04327200
$ POP OMIT 04327400
$ SET OMIT = NOT(SHAREDISK) 04327600
IF SC LSS "0" THEN JUMP OUT TO BAD; SI:=SI+1; 04328200
IF SC GTR "9" THEN JUMP OUT TO BAD); 04328400
$ SET OMIT = SHAREDISK 04328600
SI:=SI-5; 04328800
$ POP OMIT 04329000
$ SET OMIT = NOT(SHAREDISK) 04329200
DI:=LOC DA; DS:=2 OCT; 04329800
SI:=EUA; SI:=SI+14; SKIP EU SB; 04330000
DI:=LOC A; DI:=DI+7; SKIP 2 DB; 04330200
IF SB THEN SKIP DB; 04330400
SI:=LOC DA; SI:=SI+6; 04330600
IF SC NEQ "0" THEN GO TO BAD; SI:=SI+1; 04330800
4(IF SB THEN DS:=SET ELSE DS:=RESET; SKIP SB); 04331000
SI:=LOC A; SI:=SI+7; IF SC GTR "4" THEN GO TO BAD; 04331200
IF SC LSS "0" THEN GO BAD; 04331400
SI:=EUA; SI:=SI+EU; SKIP SB; SKIP A SB; 04331600
IF SB THEN GO TO OK; 04331800
BAD: TALLY:=1; 04332000
OK: DA:=TALLY; 04332200
END; 04332400
IF (MASK:=P) OR E.[42:1] THEN % BAD ADDRESS OR EU NOT READY 04332600
BEGIN 04332800
MSG:=5+MASK; % 5=EU NOT READY, 6=INVALID DISK ADDRESS 04333000
IF NOT MASK THEN MK:="#"; 04333200
IF (MIX NEQ 0) OR OLAYIO THEN 04333400
BEGIN 04333600
E:=@1537; GO TO QUIT; 04333800
END; 04334000
DISKMESSAGE; 04334200
DETAILRECORDENTRY; 04334400
GO TO KILLER; % LET IT HANG 04334600
END 04334800
ELSE 04335000
BEGIN % MUST BE E.[44:1], MEM.PAR. 04335200
MSG:=2; E:=@1537; GO TO QUIT; 04335400
END; 04335600
END; % IF NOT PARITY 04335800
IF IOQUE[S].[24:1] THEN % DISK PARITY ON READ 04336000
BEGIN 04336200
MSG:=3; % PARITY 04336400
E:=@20; 04336600
GO TO QUIT; 04336800
END; 04337000
MSG:=7; % WRITE LOCK 04337200
E:=@1537; 04337400
GO TO QUIT; 04337600
END; % IF DISK 04337800
04338000
$ SET OMIT = NOT(AUXMEM) 04338200
KILLL: 04351600
LOCATQUE[S].[11:1]:=0; 04351800
KILLER: 04352000
IF KEY1 NEQ 0 THEN SPOUTER(KEY1,UNITNO,35); 04352200
IF KEY2 NEQ 0 THEN FINISHDETAIL; 04352400
IF TERMINATE THEN TERMINATE(MIX&20[CTF]); 04352600
KILL([MSCW]); 04352800
END PROCEDURE DISKORAUXERROR; 04353000
PROCEDURE ACTUALIOERR(R); VALUE R; REAL R; 04353200
BEGIN 04353400
REAL MSCW = -2, 04353600
E = +1, 04353800
T = +2, 04354000
S = +3, 04354200
F = +4, 04354400
U = +5, 04354600
T1 = +6, 04354800
T2 = +7, 04355000
T3 = +8, 04355200
KEY = +9, 04355400
FIN = NT3, 04355600
IOD = NT6, 04355800
MASK = +10, 04356000
DISC = +11, 04356200
TYPE = +12, 04356400
MIX = +13; 04356500
04356600
NAME LOCN = T3; 04356800
$ SET OMIT = NOT(PACKETS) 04356899
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04356900
$ POP OMIT 04356901
04357000
LABEL L1, L2, D17, D19, D22, START, NOTREADYMESS, NTRDY, 04357200
EOF, REALEOF, TAPERETRY, SIX, SEVEN, FIX, LEAVE, 04357400
REWINDING, NOCODE, CLEAR, KILLL, KILLER; 04357600
LABEL READER, PRINTER, TAPE, DRUM, DISK, SPO, PUNCH, 04357800
PAPERPUNCH, PAPER, DATACOM; 04358000
04358200
SWITCH W := READER,PRINTER,TAPE,DRUM,DISK,SPO,PUNCH,NOCODE, 04358400
PAPERPUNCH,PAPER,DATACOM; 04358600
04358800
SUBROUTINE MAKEMESS; 04359000
BEGIN 04359200
STREAM(S1:=F.[43:5], S2:=F.[38:5], A:=TINU[U], 04359400
MX~MIX, KEY~KEY~SPACE(10)); 04359600
BEGIN 04359800
SI:=LOC A; SI:=SI+5; 04360000
DS:=LIT"*"; DS:=3 CHR; DS:=LIT" "; 04360200
CI:=CI+S1; GO TO LL; 04360400
GO L1; GO L2; GO L3; GO L4; GO L5; GO L6; GO LL; GO LL; 04360600
DS:=19 LIT"BLANK TAPE ON WRITE"; GO TO MXX; 04360800
L1: DS:= 4 LIT"BUSY"; GO TO MXX; 04361000
L2: DS:= 8 LIT"I/O MEM "; 04361200
L3: DS:= 6 LIT"PARITY"; GO TO MXX; 04361400
L4: DS:=12 LIT"I/O INV ADDR"; GO TO MXX; 04361600
L5: DS:= 9 LIT"I/O ERROR"; GO TO MXX; 04361800
L6: DS:=10 LIT"WRITE LOCK"; GO TO MXX; 04362000
LL: GO TO PS; 04362200
MXX: GO TO MIXIT; 04362400
PS: DI:=DI-5; DS:=LIT"#"; DI:=DI+4; 04362600
CI:=CI+S2; GO TO LL0; GO TO LL1; GO TO LL2; 04362800
NR: DS:= 9 LIT"NOT READY"; GO TO MIXIT; 04363000
LL0: DS:= 5 LIT"PRINT"; GO TO CHK; 04363200
LL1: DS:= 4 LIT"READ"; GO TO CHK; 04363400
LL2: DS:= 5 LIT"PUNCH"; 04363600
CHK: DS:= 5 LIT"CHECK"; 04363800
MIXIT: DS:= 6 LIT", MIX="; DS:=2 DEC; DS:=LIT"~"; 04364000
DI:= DI-3; DS:=FILL; 04364200
END; 04364400
END OF MAKEMESS; 04364600
04364800
SUBROUTINE DETAILRECORDENTRY; 04365000
BEGIN 04365200
KEY := TYPEDSPACE(ABS(T2),MAINTBUFFAREAV);% %167-04365400
M[KEY] := (ABS(T2) DIV 5 -1) & RDCTABLE[U][18:1:2]; 04365600
IF MIX NEQ 0 THEN 04365800
BEGIN 04366000
M[KEY] ~ (*P(DUP)) & MIX[20:43:5] & 04366200
(IF FINALQUE[S] LSS 0 THEN 0 ELSE 04366400
(M[M[LOCATQUE[S] INX NOT 2] INX 4].[13:11] DIV ETRLNG)+1)[9:39:9];04366600
CHECKJOBORFILEMESS(MIX, 04366800
(IF FINALQUE[S] LSS 0 THEN 0 ELSE LOCATQUE[S] INX NOT 2), 04367000
U); 04367200
END; 04367400
M[KEY+1] := TRANSACTION[U]; 04367600
M[KEY+2]:=IF TYPE=2 THENRDCTABLE[U] & U[3:43:5] ELSE 0; 04367800
M[KEY+3] := IOQUE[S]; 04368000
M[KEY+4] := R & RDCTABLE[U][3:3:5]; 04368200
IF TYPE=2 THEN 04368400
BEGIN 04368600
M[KEY+5] := MULTITABLE[U]; 04368800
M[KEY+6] := LABELTABLE[U]; 04369000
M[KEY+7] := PRNTABLE[U]; 04369200
M[KEY+8] := 0; 04369400
M[KEY+9] := 16; 04369600
END; 04369800
IF T2 GTR 0 THEN LINKUP(TYPE+1,KEY); 04370000
END DETAILRECORDENTRY; 04370200
04370400
DEFINE MAKEMLOG(MAKEMLOG1) = 04370600
BEGIN 04370800
T2:=MAKEMLOG1; DETAILRECORDENTRY; 04371000
END#; 04371200
04371400
P(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); 04371600
04371800
$ SET OMIT = DATACOM 04371900
% THIS CODE WAS PLACED HERE FROM OUTER BLOCK TO AVOID CAUSING 04371910
IF R=0 % OVERFLOW OF INTERRUPT STACK 04371920
THEN BEGIN STREAM(B:=T:=SPACE(10)); 04371930
DS:=42LIT"#DATACOM/INQUIRY INTERRUPT IGNORED BY MCP~"; 04371940
SPOUT(T); 04371950
GO KILLER; 04371955
END; 04371960
$ POP OMIT 04371970
U:=LOCATQUE[S:=R.[3:5]].[12:6]; 04372000
MIX~LOCATQUE[S].[3:5]; 04372050
R:=R&IOQUE[S][3:43:5]; % RESTORE UNIT DESIGNATE 04372100
START: 04372200
T:=UNIT[U]&0[13:13:2]; 04372400
TRANSACTION[U] := TRANSACTION[U]-1; 04372600
TYPE := T.[1:4]; 04372800
MASK:=IF (T2:=FINALQUE[S]) LSS 0 THEN T2.[25:8] ELSE @377; 04373000
IF (E:=T.[5:8] AND MASK) = 0 THEN % ACCEPTABLE 04373200
BEGIN 04373400
F:=1; % RETAIN ERROR FIELD 04373600
GO TO FIX; 04373800
END; 04374000
IF E THEN % BUSY 04374200
BEGIN 04374400
T3:=1 & (U=30)[43:47:1]; % BUSY/INCOMPLETE MASK 04374600
IF U LSS 16 AND TRANSACTION[U] LEQ 0 THEN 04374800
BEGIN 04375000
P(0); % DONT SPOUT MESSAGE 04375200
GO TO REWINDING; 04375400
END; 04375600
IF U NEQ 25 THEN % NOT SPO 04375800
BEGIN 04376000
F:=1; % BUSY 04376200
MAKEMESS; 04376400
SPOUTER(KEY,UNITNO,35); 04376600
END; 04376800
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04377000
L1: DO BEGIN 04377200
SLEEP([CLOCK],NOT CLOCK); 04377400
UNIT[U]:=(*P(DUP))&P(T,XCH)[CTC]; 04377600
STARTIO(U); 04377800
SLEEP([UNIT[U]],@100000000000); 04378000
TRANSACTION[U] := TRANSACTION[U]-1; 04378200
END UNTIL (UNIT[U].[5:8] AND T3) = 0; 04378400
TRANSACTION[U] := TRANSACTION[U]+1; 04378600
IF (UNIT[U].[5:8] AND MASK) = 0 THEN GO TO CLEAR; 04378800
GO TO START; 04379000
END; 04379200
04379400
IF E.[45:1] THEN % NOT READY 04379600
BEGIN 04379800
IF E.[43:1] THEN 04380000
BEGIN 04380200
IF TYPE=0 THEN GO TO READER; % READ CHECK 04380400
IF TYPE=1 THEN GO TO PRINTER; % PRINT CHECK 04380600
IF TYPE=6 THEN GO TO PUNCH; % PUNCH CHECK 04380800
END; 04381000
IF U NEQ 25 THEN % NOT SPO. 04381200
BEGIN 04381400
NOTREADYMESS: 04381600
F:=96; % NOT READY 04381800
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04382000
MAKEMESS; 04382200
P(1); % SPOUT MESSAGE 04382400
REWINDING: 04382600
READY := NOT TWO(U) AND READY; 04382800
NTRDY: 04383000
RRRMECH:=NOT TWO(U) AND RRRMECH; 04383200
IF P THEN SPOUTER(KEY,UNITNO,35); 04383400
END; 04383600
UNIT[U].[5:10] := 2; 04383800
RRRMECH ~ NOT TWO(U) AND RRRMECH; % LET STATUS FIND IT %115-04383900
GO TO KILLL; 04385400
END; 04385600
D17: 04385800
IF E.[46:1] THEN % I/O MEMORY PARITY 04386000
BEGIN 04386200
F:=2; % I/O MEM PARITY 04386400
L2: MAKEMESS; 04386600
SPOUTER(KEY,UNITNO,35); 04386800
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04387000
P(@1537); % ACCEPT EOF/EOT/EOP 04387200
GO TO SIX; 04387400
END; 04387600
IF E.[41:1] AND TYPE NEQ 2 THEN % I/O INVALID ADDRESS 04387800
BEGIN % [41:1] FOR TAPE = BACKUP DRIVE 04388000
D22: F:=4; % I/O INVALID ADDRESS 04388200
GO TO L2; 04388400
END; 04388600
04388800
GO TO W[TYPE]; 04389000
04389200
D19: E := 1023; GO TO D17; 04389400
04389600
SPO: 04389800
IF E.[43:1] THEN GO TO L1; % ERROR BUTTON 04390000
GO TO D19; 04390200
04390400
PRINTER: 04390600
IF E.[42:1] THEN % END OF PAGE 04390800
BEGIN 04391000
IF IOQUE[S].[27:6]=0 THEN GO TO FIX; % NOT SPACING 04391200
COMMENT IGNORE EOP IF NO SPACE OR SKIP; 04391400
IF RDCTABLE[U] OR MULTITABLE[U]="FULLPAGE" %724-04391550
THEN IF IOQUE[S].[28:1] THEN IOQUE[S].[FF]~@40013 %DBL-CH 11 04391560
ELSE IOQUE[S].[FF]~@40012 % DBL SINGLE - SKIP TO CH 10 04391570
ELSE % SKIP TO CHAN 1 ON EOP IF NOT 66 LINES %724-04391580
IOQUE[S].[18:15] := @4000; % INHIBIT DATA XFER, SKIP TO CHANNEL 04391600
GO TO CLEAR; 04391800
END; 04392000
IF E.[43:1] THEN 04392200
BEGIN 04392400
E:=0; % PRINT CHECK 04392600
MAKEMESS; 04392800
SPOUTER(KEY,UNITNO,35); 04393000
IF E.[45:1] THEN GO TO NOTREADYMESS; % PRINTER NOT READY 04393200
MAKEMLOG(IF TYPE=2 THEN 10 ELSE 5); 04393400
P(0); % CLEAR ERROR FIELD 04393600
TINU[U].[18:12] := P(DUP).[18:12]+1; 04393800
GO TO SIX; 04394000
END; 04394200
GO TO D19; % PARITY 04394400
04394600
READER: 04394800
IF E.[43:1] THEN % READ CHECK 04395000
BEGIN 04395200
TINU[U].[18:12] := P(DUP).[18:12]+1; 04395400
F:=32; % READ CHECK 04395600
MAKEMLOG(5); 04395800
MAKEMESS; 04396000
P(1); % SPOUT MESSAGE 04396200
GO TO NTRDY; 04396400
END; 04396600
IF E.[42:1] THEN % EOF CARD READER-TREAT AS NOT READY 04396800
BEGIN 04397000
UNIT[U].[5:8] := 4; % ERROR FIELD=NOT READY 04397200
R.[25:8] := 4; % RESLT.DESC.=NOT READY 04397400
TRANSACTION[U] := TRANSACTION[U]+1; 04397600
GO TO START; 04397800
END; 04398000
COMMENT MUST BE D19 - USUALLY INVALID CHARACTOR; 04398200
STREAM(A:=0 : B:=IOQUE[S]); 04398400
BEGIN 04398600
DI := A; SI := B; DI := DI+8; 04398800
IF SC = @14 THEN A := DI; 04399000
2(40(DI:=DI+8; SI:= SI+1; 04399200
IF SC = @14 THEN JUMP OUT 2 TO L); 04399400
DI := DI-8; SI := SI-1;); 04399600
DI := A; 04399800
L: A := DI; 04400000
END; 04400200
IF (T1 := P) = 0 THEN GO TO D19; % NOT INVALID CHARACTER 04400400
IF T1 NEQ 1 THEN % NOT IN COLUMN 1 04400600
BEGIN 04400800
STREAM(a:=TINU[U],T1,KEY:=KEY:=SPACE(10)); 04401000
BEGIN 04401200
DS := LIT "#"; SI := LOC A; SI := SI+5; 04401400
DS := 3 CHR; 04401600
DS := 16 LIT " INV CHR IN COL "; 04401800
DS := 2 DEC; DS := LIT "~"; 04402000
END; 04402200
P(1); % SPOUT MESSAGE 04402400
GO TO NTRDY; 04402600
END; 04402800
E := @40; 04403000
F := @3100001; 04403200
GO TO LEAVE; 04403400
04403600
PUNCH: 04403800
IF E.[43:1] THEN 04404000
BEGIN 04404200
F:=64; % PUNCH CHECK 04404400
MAKEMESS; 04404600
SPOUTER(KEY,UNITNO,35); 04404800
% NEW PUNCH DOES NOT GO NOT-READY ON PUNCH CHECK 04405000
IF E.[45:1] THEN GO TO NOTREADYMESS; % NOT READY 04405200
MAKEMLOG(5); 04405400
TINU[U].[18:12]:=P(DUP).[18:12]+1; 04405600
F:=0; % ZERO ERROR FIELD 04405800
GO TO CLEAR; 04406000
END; 04406200
GO TO D19; % PARITY 04406400
04406600
PAPERPUNCH: 04406800
IF R.[27:1] THEN % EOR 04407000
BEGIN 04407200
P(@40); 04407400
GO TO SIX; 04407600
END; 04407800
GO TO D19; % PARITY 04408000
04408200
PAPER: 04408400
IF R.[27:2] NEQ 0 THEN GO TO EOF; % BOT/EOT 04408600
IF E.[44:1] THEN % PARITY 04408800
BEGIN 04409000
P(@20); 04409200
GO TO SIX; 04409400
END; 04409600
GO TO NOCODE; 04409800
04410000
DATACOM: 04410200
IF(T3:=1&E[43:43:1])=@21 THEN GO TO L1; 04410400
NOCODE: 04410600
F := 5; % I/O ERROR 04410800
GO TO L2; 04411000
04411200
DRUM: % DRUM NOW HANDLED IN DISKORAUXERROR 04411400
DISK: % DISK NOW HANDLED IN DISKORAUXERROR 04411600
DO UNTIL FALSE; 04411800
04412000
TAPE: 04412200
TRANSACTION[U] := TRANSACTION[U]+1; 04412400
IF E.[44:1] THEN 04412600
IF R.[2:1] THEN % MOD III DESCRIPTOR 04412800
BEGIN % COULD BE MEM.PAR.,BLANK TAPE,BOT,EOT 04413000
IF R.[11:1] THEN GO TO D19; % MEMORY PARITY 04413200
OPTION:=OPTION OR M; % MEANS MOD3IOS:=TRUE 04413400
IF R.[24:1] THEN % READING 04413600
BEGIN 04413800
IF R.[13:1] THEN R.[27:1]:=1; BOT, SET EOF 04414000
IF R.[14:1] THEN % EOT 04414200
IF (E AND @367)=0 THEN % PARITY 04414400
IF R.[27:1]=0 THEN % NOT EOF 04414600
GO TO FIX; % FINISH I/O 04414800
END; 04415000
ELSE 04415200
BEGIN % WRITING 04415400
IF R.[2:1] THEN % BLANK TAPE ON WRITE 04415600
BEGIN 04415800
F:=9; % BLANK TAPE ON WRITE 04416000
MAKEMESS; 04416200
SPOUTER(KEY,UNITNO,35); 04416400
MAKEMLOG(10); 04416600
P(16); 04416800
GO TO SIX; 04417000
END; 04417200
IF R.[14:1] THEN R.[27:1]:=1 ELSE GO FIX; % EOT,SET EOF BIT 04417400
END; 04417600
END % MOD III DESCRIPTOR 04417800
ELSE GO TO D19; % PARITY 04418000
IF R.[24:1] THEN 04418200
BEGIN 04418400
IF E.[41:1] THEN GO TO D22; % INVALID ADDRESS 04418600
IF R.[27:1] THEN % EOT 04418800
EOF: IF MASK.[42;1] THEN % EOF OK 04419000
BEGIN 04419200
REALEOF: F:=1&(IF R.[24:1] THEN @31 ELSE 0)[CTF]; 04419400
T.[5:8] := @40; 04419600
GO TO FIX; 04419800
END 04420000
ELSE 04420200
BEGIN % EOF NOT ACCEPTABLE 04420400
P(@40); 04420600
GO TO SIX; 04420800
END; 04421000
TAPERETRY: 04421200
MAKEMLOG(-TAPEBUFFERSIZE); 04421400
IF (T:=TAPEPARITYRETRY(R,U,KEY)).[5:8]=32 AND 04421600
LOCATQUE[S].[3:5] NEQ 0 THEN GO TO REALEOF; 04421800
U~IOQUE[T.[FF]].[3:4]; 04421900
P(T.[5:8]); 04422000
GO TO SIX; 04422200
END; 04422400
IF E.[41:1] THEN % WRITE RING 04422600
IF E.[43:1] THEN % PARITY,WRITE RING 04422800
BEGIN 04423000
F:=6; % WRITE LOCK 04423200
GO TO L2; 04423400
END 04423600
ELSE GO TO D22; % INVALID ADDRESS 04423800
IF E.[43:1] THEN GO TO TAPERETRY; % PARITY,WRITE RING ONLY 04424000
P(@40); 04424200
SIX: 04424400
T := T&P(XCH)[5:40:8]; 04424600
F := 1; 04424800
FIX: 04425000
E := T.[5:8]|F; 04425200
FIN := S; 04425400
IOD := IOQUE[S]; 04425600
SEVEN: 04425800
RETURNIOSPACE(S); 04426000
04426200
T.[FF]:=S:=LOCATUE[S].[FF]; 04426600
IF F = @3100001 THEN 04426800
IF S NEQ @77777 THEN GO TO SEVEN; 04427000
S:=FIN; 04427200
IF FALSE THEN 04427400
LEAVE: 04427600
IOD := IOQUE[S]; 04427800
FIN := FINALQUE[S] AND NOT MEMORY; 04428000
IF IOD.[24:1] THEN 04428200
BEGIN 04428400
NT4 := M[IOD INX ( IF IOD.[22:1] THEN 1 ELSE NOT 0)]; 04428600
FINISHOFFIO(U); 04428800
END; 04429000
IF ( T1:= FIN) LSS 0 THEN 04429200
P(R&E[25:40:8]&IOD[3:3:5] OR IOMASK,LOCATQUE[S],~); 04429400
ELSE 04429600
BEGIN 04429800
IF E NEQ 0 THEN 04430000
BEGIN 04430200
P(.T1,PRL); 04430400
T1 := T1&E25:40:8]; 04430600
END 04430800
ELSE P(.T,IOR); 04431000
LOCN := [M[LOCATQUE[S]]; 04431200
IOD := IOD.[33:15]; 04431400
WHILE LOCN[0].[33:15] NEQ IOD DO LOCN := 1 INX LOCN; 04431600
LOCN[0] := P(.T1,LOD); 04431800
END; 04432000
UNIT[U] := T; 04432200
CLEAR: 04432400
UNIT[U] := (*P(DUP))&F[5:20:13]; 04432600
STARTIO(U); 04432800
KILLL: 04433000
LOCATQUE[S].[11:1]:=0; 04433200
KILLER: 04433400
KILL([MSCW]); 04433600
END; 04433800
$ SET OMIT = NOT DEBUGGING 04544999
REAL PROCEDURE TAPEPARITYRETRY(R,U,KEY);% 04548000
VALUE R,U,KEY;% 04549000
REAL R,U,KEY;% 04550000
BEGIN REAL T1,T2,T3; INTEGER I= T1;% 04551000
REAL RESULT,IOD,OIOD,SPACEMASK,SPACEIOD,M,N,W,MODE;% 04552000
REAL J,K;% 04553000
REAL ERASEIOD=SPACEMASK;% 04554000
REAL Z,Y,MIX,BSIZE; 04554100
LABEL XIO,GIVEUP; 04554200
LABEL RP,LX; 04554300
REAL SIZE,T4,LIMIT; 04554500
REAL PTR,BUFFER,BUFFERSIZE,% 04554600
PATTERN,PATTERN1,PATTERN2,PATTERNWORD;% DON"T CHANGE ORDER04554700
BOOLEAN TESTING,SPACING,FLAGGER; 04554800
$ SET OMIT = NOT(PACKETS) 04554899
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04554900
$ POP OMIT 04554901
LABEL XXIT,EXIT,ENDIT,XEXIT; 04555000
SUBROUTINE RECORDRETRY;% 04555050
BEGIN% 04555100
IF PTR-KEY = TAPEBUFFERSIZE-1 THEN% 04555150
BEGIN% 04555200
T4 := TYPEDSPACE(TAPEBUFFERSIZE,MAINTBUFFAREAV);% %167-04555250
MOVE(10,KEY,T4);% 04555300
MEMORY[KEY+8]:= TAPEBUFFERSIZE-10;% 04555350
MEMORY[KEY+9]:= 1023;% 04555400
LINKUP(3,KEY);% 04555450
KEY:= T4; PTR:= KEY+9;% 04555500
END;% 04555550
MEMORY[PTR:=PTR+1]:= IOD;% 04555600
MEMORY[PTR:=PTR+1]:= RESULT & RDCTABLE[U][19:1:2];% 04555650
END RECORDRETRY;% 04555700
SUBROUTINE DOIONOW;% 04556000
BEGIN FOR Y~1 STEP 1 UNTIL 18 DO 04556100
BEGIN IF R.[24:1]THEN 04557000
BEGIN % WAIT 1/15 SEC BETWEEN READ RETRIES 04557100
WHILE T4>CLOCK+P(RTR) DO SLEEP(1,1); 04557200
T4~CLOCK+P(RTR+4); 04557300
END; 04557400
IF IOQUESLOTS=0 THENSLEEP([IOQUESLOTS],83); 04558000
IOQUESLOTS:=IOQUESLOTS-1; 04558500
IOQUEAVAIL:=IOQUE[T1:=IOQUEAVAIL]; 04559000
IOQUE[T1]~ IOD;% 04560000
LOCATQUE[T1]~LOCATQUE[T2 ~(T3~UNIT[U]).[18:15]]&RESULT]% 04561000
[33:33:15]&T2[18:33:15];% 04562000
UNIT[U] ~ T3&T1[18:33:15]&64[5:35:13];% 04563000
STARTIO(U);% 04564000
FINALQUE[T1] ~ NABS(IOD)& 0 [25:40:8] OR IOMASK;% 04565000
RESULT ~ 0;% 04566000
SLEEP([UNIT[U]],@100000000000);% 04567000
IF RESULT.[30:1] THEN % NOT READY 04567010
BEGIN 04567020
MODE := (-16); 04567030
GO TO EXIT; 04567040
END; 04567050
IF RESULT.[29:1] AND RESULT.[2:1] THEN 04567100
BEGIN 04567150
IF RESULT.[12:1] THEN % BLANK TAPE 04567200
IF IOD.[24:1] THEN % READ 04567250
TRANSACTION[U]~TRANSACTION[U]-1&IOD[1:22:1] ELSE04567300
BEGIN; % WRITE 04567310
STREAM(A~TINU[U],T~T2~SPACE(3)); 04567320
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04567400
DS!21 LIT" BLANK TAPE ON WRITE~"; 04567500
END; 04567550
SPOUTER(T2,UNITNO,35); 04567600
GO TO XXIT; 04567700
END; 04567750
IF RESULT.[11:1] THEN % MEM PARITY 04567770
BEGIN; 04567780
STREAM(A~TINU[U],T~T2~SPACE(3)); 04567790
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04567800
DS~13 LIT" I/O MEM PAR~"; 04567810
END; 04567820
SPOUTER(T2,UNITNO,35); 04567830
XXIT: MODE := 16; 04567840
IF TESTING THEN GO XIO; 04567845
RECORDRETRY; 04567850
GO TO EXIT; 04567855
END; 04567860
IF RESULT.[13:21]!0 THEN Y~18; 04567870
END ELSE GO TO XIO; 04567900
END;% 04568000
RESULT.[27:1]~1; MODE~32; 04568100
XIO: IF NOT SPACING THEN RECORDRETRY; 04568200
END DOIONOW;% 04568250
SUBROUTINE SPACEBACK; 04568300
BEGIN 04568310
IF TRANSACTION[U]=1 THEN 04568320
BEGIN 04568330
IOD:=@4200000000&IOD[3:3:5]; 04568340
DOIONOW; 04568350
I:=TWO(U); 04568360
T2:=CLOCK+P(RTR)+600; 04568364
COMPLEXSLEEP((P(RRR) AND I)!0 OR T2<CLOCK+P(RTR)); 04568366
IF (P(RRR) AND I)=0 THEN % TIME OUT => NOT READY04568370
BEGIN MODE:=16; 04568372
GO TO EXIT; 04568374
END; 04568376
END ELSE 04568380
BEGIN 04568390
M:=W; 04568400
IOD:=SPACEIOD; 04568410
J:=0; 04568420
SPACING:= TRUE;% 04568425
DO BEGIN 04568430
DOIONOW; 04568440
TRANSACTION[U]:=(*P(DUP))+1); 04568450
J:=J+1; 04568460
END UNTIL ((M:=RESULT.[CF]-SPACEIOD.[CF]+M) LSS 0 04568470
OR RESULT.[27:1] AND J GTR 1; 04568480
IF NOT TESTING THEN SPACING:= FALSE; 04568485
TRANSACTION[U]:=(*P(DUP))-2; 04568490
IOD:=SPACEIOD&0[22:47:1]; 04568500
DOIONOW; 04568510
IF N=0 THEN BSIZE:=RESULT.[CF]-IOD.[CF] ELSE 04568520
IF BSIZE!RESULT.[CF]-IOD.[CF] THEN 04568530
BEGIN 04568540
STREAM(A:=TINU[U],D:=T2:=SPACE(10)); 04568550
BEGIN SI:=LOC A;SI:=SI+5;DS:=3 CHR; 04568560
DS:=13 LIT" ERASE ERROR~"; 04568570
END; 04568580
SPOUTER(T2,UNITNO,35); 04568590
FLAGGER ~ 1; 04568595
GO GIVEUP; 04568600
END; 04568610
END; 04568620
END; % OF SPACEBACK 04568630
TINU[U].[18:12] ~ P(DUP).[18:12]~1;% 04569000
MIX ~ LOCATQUE[UNIT[U].[FF]].[3:5]; 04569100
FLAGGER ~ FINALQUE[UNIT[U].[FF]] < 0; % NOT OBJECT JOB 04569200
OIOD ~ NFLAG(IOQUE[UNIT[U].[18:15]]);% 04570000
PTR:= KEY+9; 04570100
IF R.[24:1] THEN% 04571000
BEGIN COMMENT READ RETRY;% 04572000
SPACEMASK ~ OIOD.[21:2]|@1111 EQV NOT @0123;% 04573000
SPACEIOD ~ OIOD&1[8:38:10]&1[23:47:1];% 04574000
FOR M ~ 1 STEP 1 UNTIL 3 DO% 04575000
BEGIN SPACEIOD ~ SPACEIOD&SPACEMASK[21:46:2];% 04576000
FOR N ~ 1 STEP 1 UNTIL 5 DO% 04577000
BEGIN IOD ~ SPACEIOD;% 04578000
IF N!1 OR M!1 THEN DOIONOW ELSE 04579000
IF NOT(R.[29:1]AND R.[2:1] AND R.[12:1]) 04579100
THEN DOIONOW; 04579200
IF RESULT.[28:1] THEN% 04580000
BEGIN MODE ~ 0;% 04581000
IOD ~ OIOD;% 04582000
END% 04583000
ELSE BEGIN MODE ~ 8;% 04584000
IOD ~ OIOD&SPACEMASK[21:43:2];% 04585000
END;% 04586000
DOIONOW;% 04587000
IF NOT RESULT.[28:1] THEN GO TO EXIT;% 04588000
IF MOD3IOS THEN IF OIOD.[23:1] THEN 04588010
BEGIN Z~IOD~OIOD&SPACEMAKS[21:40:2] 04588020
&(OIOD.[33:15]+(OIOD.[8:10]-1) 04588030
&OIOD[1:22:1]])[33:33:15]; 04588040
DOIONOW; MODE~0; 04588050
IF RESULT.[28:1] THEN 04588060
BEGIN IOD~OIOD; DOIONOW; 04588070
IF NOT RESULT.[28:1] THEN 04588080
GO TO EXIT; 04588090
IOD~Z&SPACEMASK[21:46:2]; 04588100
DOIONOW; MODE~8; 04588110
IF RESULT.[28:1] THEN 04588120
BEGIN IOD~OIOD&SPACEMASK 04588130
[21:43:2]; 04588140
RP: DOIONOW; 04588150
IF RESULT.[28:1] THEN 04588160
GO TO LX; 04588170
GO TO EXIT; 04588180
END; 04588190
END; 04588200
Z~ABS(IOD.[33:15]-RESULT.[33:15]); 04588210
IF IOD.[21:2]=0 THEN 04588220
Z~Z-(RESULT.[15:3]=0); 04588230
IF IOD.[8:10]<Z THEN 04588240
BEGIN IOD~OIOD; MODE~0; GO TO RP END;04588250
IF IOD.[22;1] THEN 04588260
STREAM(Z,Y~Z DIV 64, 04588270
S~RESULT.[33:15]+1, 04588280
SK~(RESULT.[15:3]+1).[45:3], 04588290
GM~(IF IOD.[2:1] THEN 0 04588300
ELSE "~"), 04588310
D~OIOD.[33:15]); 04588320
BEGIN SI~S; SI~SI+SK; 04588330
Y(16(DS~32 CHR)); 04588340
Z(DS~8 CHR); 04588350
SK(DS~LIT "0"); 04588360
DI~DI-SK; SI~LOC GM; 04588370
SI~SI+7; DS~CHR; 04588380
END ELSE 04588390
STREAM(Z,Y~Z DIV 64, 04588400
S~RESULT.[33:15]-1, 04588410
SK~(RESULT.[15:3]+7).[45:3], 04588420
FL~(IF IOD.[21:1] THEN 0 04588430
ELSE @14), 04588440
FK~(8-RESULT.[15:3]).[45:3], 04588450
D~OIOD.[33:15]); 04588460
BEGIN SI~S; SI~SI+SK; DI~DI+7; 04588470
Y(16(32(DS~CHR); SI~SI-2; 04588480
DI~DI-2))); 04588490
Z(8(DS~CHR; SI~SI-2; DI~DI-2));04588500
SI~LOC FL; SI~SI+7; 04588510
FK(DS~CHR; SI~SI-1; DI~DI-2); 04588520
END; 04588530
IOD~@140000005&OIOD[22:22:1] 04588540
&OIOD[3:3:5]; 04588550
DOIONOW; GO TO EXIT; 04588560
LX: END; 04588570
END;% 04589000
N ~ IF TRANSACTION[U] < 15 THEN% 04590000
TRANSACTION[U] ELSE 15;% 04591000
IOD ~ SPACEIOD&SPACEMASK[21:40:2];% 04592000
SPACING:= TRUE; 04592100
FOR W ~ 1 STEP 1 UNTIL N DO% 04593000
BEGIN DOIONOW;% 04594000
IF RESULT.[27:1] THEN N~0;% 04595000
END;% 04596000
IOD ~ SPACEIOD&SPACEMASK[21:37:2];% 04597000
FOR N ~ 3 STEP 1 UNTIL W DO DOIONOW;% 04598000
IOD ~ OIOD;% 04599000
MODE ~ 0;% 04600000
SPACING:= FALSE; 04600100
DOIONOW;% 04601000
IF NOT RESULT.[28:1] THEN GO TO EXIT;% 04602000
END;% 04603000
MODE ~ 16;% 04604000
END ELSE BEGIN COMMENT WRITE RETRY;% 04605000
LIMIT ~ @15000; 04605500
ERASEIOD ~ (SPACEIOD ~ OIOD&0[8:38:10]&7[22:45:3]&[T2]% 04606000
[33:33:15])&@112[18:47:7];% 04607000
W ~ R.[33:15]-OIOD.[33:15]+2;% 04608000
WHILE TRUE DO 04609000
BEGIN 04610000
SPACEBACK; 04611000
IF MIX!0 THEN IF TERMSET(MIX) THEN GO XEXIT; 04626000
IF (N~N+W+128) GTR LIMIT THEN GO GIVEUP; 04627000
IOD ~ ERASEIOD&N[9:39:9];% 04628000
SPACING:= TRUE;% 04628100
FOR J ~ 0 STEP 512 UNTIL N DO% 04629000
BEGIN TRANSACTION[U] ~ TRANSACTION[U]-1;% 04630000
DOIONOW;% 04631000
IOD ~ ERASEIOD&1[8:47:1];% 04632000
IF RESULT.[27:1] THEN 04633000
BEGIN 04633100
IF NOT R.[27:1] THEN LIMIT~J+3000; 04633200
R.[27:1]~1; 04633300
END; 04633400
END;% 04634000
SPACING:= FALSE;% 04634100
IOD:= IOD & N[CTC];% 04634200
RECORDRETRY;% 04634300
IOD ~ OIOD;% 04635000
DOIONOW;% 04636000
IF RESULT.[27:1] THEN R.[27:1] ~ 1;% 04637000
IF NOT RESULT.[28:1] THEN% 04638000
BEGIN 04638100
SIZE~RESULT.[CF]-OIOD.[CF]; 04638200
SPACEBACK; 04638300
IOD~SPACEIOD&0[22:47:1]; 04638650
DOIONOW; 04638700
IF NOT(RESULT.[28:1] OR (OIOD.[2:1] AND 04638800
(RESULT.[CF]-SPACEIOD.[CF]!SIZE))) THEN 04638900
BEGIN 04639000
MODE~0&R[42:27:1]; 04639100
GO TO EXIT; 04639200
END; 04640000
END; 04641000
END;% 04642000
GIVEUP: 04642900
STREAM(A~TINU[U], T~T2~SPACE(6)); 04644000
BEGIN SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR;% 04645000
DS ~ 11 LIT " WR PARITY~";% 04646000
END;% 04647000
IF MIX!0 THEN IF (NOT OIOD).[21:1] THEN % ALPHA TAPE 04647050
BEGIN STREAM(T~0: S~OIOD.[CF], QM~@14); 04647100
BEGIN SI ~ S; DI ~ LOC QM; DI ~ DI+7; 04647150
ST: IF SC="~" THEN GO F; 04647200
IF SC=DC THEN GO L; 04647250
DI ~ DI-1; 04647300
GO ST; 04647350
L: TALLY~1; T~TALLY; 04647400
F: END; 04647450
IF P THEN 04647500
BEGIN STREAM(T2); 04647550
BEGIN DI ~ DI+13; 04647600
DS ~ 29LIT", TRIED TO WRITE INVALID CHR~"; 04647650
END; 04647700
FLAGGER ~ 1; 04647750
END; END; 04647800
SPOUTER(T2,UNITNO,25); 04648000
IF MIX!0 AND NOT FLAGGER THEN 04648050
BEGIN 04648100
TAPEPARITYRETRY ~ Y ~ WRITEPARITYREELSWITCH(OIOD,0); 04648150
MODE ~ Y.[5:8]; 04648200
R.[27:1] ~ 0; 04648250
GO ENDIT; 04648300
END; 04648350
XEXIT: 04648400
MODE ~ 16;% 04649000
END;% 04650000
EXIT: TAPEPARITYRETRY:= UNIT[U] & MODE[5:40:8]; 04651000
ENDIT: 04651010
MEMORY[KEY+8] := PTR-KEY-9; 04651050
MEMORY[KEY+9]:=ABS(MODE); 04651100
MEMORY[KEY] := P(DUP,LOD) & ((PTR-KEY) DIV 5)[39:39:9]; 04651200
IF (MODE!16) OR (R.[24:1]) THEN LINKUP(3,KEY) ELSE 04651300
BEGIN 04651400
BUFFER:= OIOD INX 0; 04651500
BUFFERSIZE:= OIOD.[8:10]; 04651600
IF NOT OIOD.[21:1] THEN % ALPHA WRITE - CHECK Q-MARKS 04651700
BEGIN 04651800
STREAM(T:=0: 04651900
TEMP:=0, SVSI:=0, 04652000
BUFFSTART:=BUFFER, 04652100
BUFFEND:=BUFFER+BUFFERSIZE); 04652200
BEGIN 04652300
SI:=BUFFEND; DI:=LOC TEMP; DS:= CHR; 04652400
DI:=BUFFEND; DS:=LIT"-"; DI:=DI-1; DS:=RESET; %Q-MARK 04652500
SI:=BUFFSTART; 04652600
IF SC > 9 THEN 04652700
BEGIN 04652800
L1: SI:=SI+1; IF SC>9 THEN GO L1; 04652900
END; 04653000
L2: SI:=SI+1; IF SC{9 THEN GO L2; 04653100
SVSI:=SI; 04653200
SI:=LOC SVSI; SI:=SI+5; 04653300
DI:=LOC BUFFEND; DI:=DI+5; 04653400
IF 3 SC!DC THEN TALLY:=1; 04653500
SI:=BUFFEND; SI:=LOC TEMP; DS:= CHR; 04653600
T:=TALLY; 04653700
END; 04653800
I:=POLISH; 04653900
MEMORY[KEY+2]:= P(DUP,LOD) & 1[1:47:1]; 04654000
END; 04654100
IF STOPTEST OR FLAGGER THEN LINKUP(3,KEY) ELSE 04654200
BEGIN 04654300
MEMORY[KEY] := NABS(P(DUP,LOD)); 04654400
LINKUP(3,KEY); 04654500
TESTING:= SPACING:= TRUE; N:=0; 04654600
BUFFERSIZE:= BUFFERSIZE-1; 04654700
OIOD:= OIOD & 1[18:42:6]; 04654800
PTR:= KEY+8; 04654900
STREAM(MOD2IOS:=NOT(MOD3IOS+62), D:=[PATTERN]); 04655000
BEGIN 04655100
DS:=13 LIT"01248+|~<(.G{"; 04655200
MOD2IOS(DI:=DI-6; DS:=LIT"""; DI:=DI+5); 04655300
DS:= LIT"""; DS:= LIT"""; 04655400
DS:=3 LIT"]$("; 04655500
END; 04655600
SLEEP([MEMORY[KEY]],@1000000000000000); 04655700
MEMORY[PTR]:= 0; MOVE(191,PTR,PTR+1); 04655800
FOR K:=0 STEP 1 UNTIL 15 DO 04655900
BEGIN 04656000
STREAM(A:=[PATTERN], 04656100
K:=K+(K=15), M:=4+4|(K<14), N:=1+(K>13), 04656200
SIZEDIV64:=BUFFERSIZE.[36:6], BUFFERSIZE, 04656300
BUFFER); 04656400
BEGIN 04656500
SI:=A; SI:=SI+K; 04656600
M(DS:=N CHR; SI:=SI-N); 04656700
SI:=BUFFER; 04656800
SIZEDIV64(DS:=32 WDS; DS:=32 WDS); DS:=BUFFERSIZE WDS; 04656900
DI:=A; DI:=DI+24; DS:=WDS; 04657000
END; 04657100
IOD:= OIOD:= OIOD & ((K<7) OR (K>13))[21:47:1]; 04657200
DOIONOW; 04657300
MEMORY[PTR]:= RESULT & RDCTABLE[U][19:1:2]; 04657400
SPACEBACK; 04657500
STREAM(SIZEDIV64:=BUFFERSIZE.[36:6],BUFFERSIZE, 04657600
BUFFER); 04657700
BEGIN 04657800
DS:=8 LIT" "; SI:=BUFFER; 04657900
SIZEDIV64(DS:=32 WDS; DS:=32 WDS); DS:=BUFFERSIZE WDS; 04658000
END; 04658100
IOD:= OIOD & 1[24:47:1]; 04658200
DOIONOW; 04658300
MEMORY[PTR+1]:= RESULT & RDCTABLE[U][19:1:2]; 04658400
STREAM(A:=[PATTERN] INX 3, 04658500
CHERR:=0, WRDERR:=0, WRDCNT:=0, 04658600
LOOP:=0, FORSEVEN:=1, LEAPFROG:=0, 04658700
WDSLEFT:=I:=(J:=IF (SIZE:=ABS(BUFFER-(RESULT INX 0))) 04658800
LEQ BUFFERSIZE THEN SIZE ELSE BUFFERSIZE+1) MOD 63, 04658900
V:=IF J<64 THEN J ELSE 63, 04659000
N:=IF J<64 THEN 1 ELSE J DIV 63, 04659100
RECYCLE:= IF J<64 THEN 0 ELSE IF I=0 THEN 0 ELSE 1, 04659200
TEMP:=0, SVDI:=0, 04659300
BITLOCN:=PTR+3, WRDLOCN:=PTR+5, 04659400
BUFFER); 04659500
BEGIN; 04659600
LEAPFROG:= CI; TALLY:=0; % USED ONLY FOR LEAPFROG RETURN 04659700
N(V(SI:=A; IF 8 SC!DC THEN 04659800
BEGIN 04659900
SI:=WRDERR; SI:=SI+8; WRDERR:=SI; 04660000
FORSEVEN(SVDI:=DI; DI:=BITLOCN; LOOP(DI:=DI+2); 04660100
SI:=LOC WRDCNT; SI:=SI+6; DS:=2 CHR; 04660200
DI:=WRDLOCN; LOOP(DI:=DI+8); 04660300
SI:=WVDI; SI:=SI-8; DS:= WDS; 04660400
TALLY:=LOOP; TALLY:=TALLY+1; LOOP:=TALLY; 04660500
SI:=LOC LOOP; SI:=SI+7; 04660600
IF SC="7" THEN 04660700
BEGIN TALLY:=0; FORSEVEN:=TALLY; END; 04660800
DI:=SVDI); 04660900
SI:=A; DI:=DI-8; TALLY:=0; 04661000
8(IF SC!DC THEN TALLY:=TALLY+1); 04661100
TEMP:=TALLY; 04661200
SI:=CHRERR; TEMP(SI:=SI+8); CHRERR:=SI; 04661300
END; 04661400
SI:=WRDCNT; SI:=SI+8; WRDCNT:=SI; 04661500
)); 04661600
RECYCLE(TALLY:=1; N:=TALLY; 04661700
TALLY:=WDSLEFT; V:=TALLY; 04661800
TALLY:=0; RECYCLE:=TALLY; 04661900
JUMP OUT TO TADPOLE); 04662000
GO TO FROG; 04662100
TADPOLE: CI:=LEAPFROG; 04662200
FROG: DI:=BITLOCN; DI:=DI-5; 04662300
SI:=LOC CHRERR; SI:=SI+5; DS:=3 CHR; 04662400
SI:=LOC WRDERR; SI:=SI+6; DS:=2 CHR; 04662500
END; 04662600
IF MEMORY[PTR].[27:1] THEN SPACEBACK; 04662700
PTR:=PTR+12; 04662800
END; 04662900
MEMORY[KEY]:= P(DUP,LOD) & 0[1:1:2] & 39[39:39:9]; 04663000
MEMORY[KEY+2]:= P(DUP,LOD) & OPTION[2:2:1]; 04663100
LINKUP(20,KEY); 04663200
END;END; 04663300
END TAPEPARITYRETRY;% 04666000
REAL PROCEDURE WRITEPARITYREELSWITCH(OIOD,RC); 04667000
VALUE OIOD,RC; REAL OIOD,RC; 04667050
% 04667100
% THE PURPOSE OF THIS ROUTINE IS TO ALLOW OBJECT PROGRAMS 04667150
% TO CHANGE MAG TAPE UNITS WHEN ENCOUNTERING A WRITE PARITY 04667200
% ERROR. THIS ROUTINE IS CALLED FROM EITHER TAPEPARITYRETRY 04667250
% IN RESPONSE TO A FATAL WRITE PARITY ERROR OR FROM 04667300
% REELCHANGER AFTER AN "RC" KEYBOARD REQUEST BY THE OPERATOR. 04667350
% 04667400
% BASICALLY, THIS ROUTINE READS INTO CORE THE LAST TWO 04667450
% SUCESSFULLY WRITTEN BLOCKS ON THE TAPE, CLOSES THE FILE 04667500
% (MARKING THE TAPE AS AN END OF REEL), OBTAINS ANOTHER 04667550
% TAPE UNIT, RE-WRITES THE TWO BLOCKS IN CORE FOLLOWED 04667600
% BY THE BLOCK IN WHICH THE PARITY ERROR OCURRED, AND 04667650
% ALLOWS THE PROGRAM TO CONTINUE WRITING ON THE NEW TAPE. 04667700
% 04667750
% WHEN THIS ROUTINE IS CALLED DUE TO AN OPERATOR "RC" 04667800
% MESSAGE, THERE IS NO FATAL PARITY ERROR AT THIS POINT. 04667850
% SO THE SAVING OF THE LAST TWO RECORDS IS UNNECESSARY 04667900
% AND ONLY THE CLOSING OF THE FILE AND OBTAINING OF A NEW 04667950
% UNIT ARE REQUIRED. 04668000
% 04668050
% THE PARAMETERS ARE USED AS FOLLOWS: 04668100
% OIOD THE ORIGINAL I/O DESCRIPTOR ON WHICH 04668150
% A FATAL ERROR OCCURRED 04668200
% 04668250
% RC 1 IF CALLED FROM REELCHANGER, 0 OTHERWISE 04668300
% 04668350
BEGIN 04668400
INTEGER I,LOGICLRC; 04668450
REAL BSIZE,FNUM,NUMBUFFS,NUMRECS,REEL); 04668500
REAL S,Y,U,OLDU,SAVEU,MIX; 04668550
REAL TEMP,T1,T2,T3,T4; 04668600
REAL IOD,RESULT,MODE,TOPIOD,TM,HOLDCT; 04668650
REAL FIRSTREC,SECREC,FIRSTRECIO,SECRECIO; 04668700
BOOLEAN TOGGLES; 04668750
ARRAY FIB[*],FPB[*],LABELA[*],TANK[*]; 04668800
% 04668850
% THE LOCAL VARIABLES ARE USED AS FOLLOWS: 04668900
% INTEGERS 04668950
% I TEMPORARY 04669000
% LOGICLRC CONTAINS THE LOGICAL RECORD COUNT 04669050
% REALS 04669100
% BSIZE BLOCK SIZE OF FILE 04669150
% FNUM FILE NUMBER WITHIN FPB 04669200
% NUMBUFFS TOTAL NUMBER OF BUFFERS DECLARED FOR FILE 04669250
% NUMRECS RECORDS PER BLOCK (BSIZE DIV RECORD SIZE) 04669275
% REEL CONTAINS THE CURRENT REEL NUMBER +1 04669300
% S INDEX INTO IOQUE OF UNSUCCESSFUL I/O 04669350
% Y TEMPORARY 04669400
% U LOGICAL UNIT NUMBER OF TAPE UNIT BEING WRITTEN 04669450
% OLDU HARDWARE UNIT NUMBER OF TAPE UNIT 04669500
% SAVEU LOGICAL UNIT OF ORIGINAL TAPE UNIT WITH ERROR 04669550
% MIX MIX INDEX OF JOB FOR WHICH RECOVERY IS ATTEMPTED 04669600
% TEMP 04669650
% T1,T2,T3,T4 TEMPORARY 04669700
% IOD HOLDS THE I/O DESCRIPTOR FOR EACH I/O ATTEMPTED 04669750
% RESULT RECEIVES THE LAST I/O RESULT DESCRIPTOR 04669800
% MODE USED TO INDICATE A SUCCESSFUL RECOVERY ATTEMPT 04669850
% TOPIOD LOCATION OF TOP I/O DESCRIPTOR IN TANK 04669900
% TM TEMPORARY, USED FOR WRITING TAPE MARK 04669950
% HOLDCT CONTAINS THE NUMBER OF FILLED BUFFERS 04670000
% FIRSTREC 04670050
% SECREC ADDRESSES OF AREAS TO HOLD LAST TWO BLOCKS 04670100
% FIRSTRECIO 04670150
% SECRECIO VARIABLE LENGTH BLOCK I/O DESCRIPTORS 04670200
% BOOLEAN 04670250
% TOGGLES USED TO HOLD VARIOUS BOOLEANS (SEE DEFINES) 04670300
% ARRAYS 04670350
% FIB FIB ARRAY, USED FOR CLOSEING THE FILE 04670400
% FPB FPB ARRAY, USED FOR OPENING NEW FILE 04670450
% LABELA ARRAY DESCRIPTOR FOR IN-CORE LABEL RECORD 04670500
% TANK TANK ARRAY, CONTAINING I/O DESCRIPTORS 04670550
% 04670600
LABEL L1,RETRY,PROB,KAPUT,RESETUNITS,ARN,ERROROUT,XIO,EXIT; 04670650
DEFINE ALFA = TOGGLES.[47:1]#, 04670700
DSED = TOGGLES.[46:1]#, 04670750
LABELED = TOGGLES.[45:1]#, 04670800
NORMALPROCESS = TOGGLES.[44:1]#, 04670850
PBT = TOGGLES.[43:1]#; 04670900
$ SET OMIT = NOT(PACKETS) 04670950
DEFINE UNITNO = PSEUDOMIX[MIX]#; 04671000
$ POP OMIT 04671050
SUBROUTINE DOIONOW; 04671100
BEGIN 04671150
% DOIONOW IS COPIED FROM TAPEPARITYRETRY 04671200
FOR Y ~ 1 STEP 1 UNTIL 18 DO 04671250
BEGIN IF IOD.[24:1] THEN 04671300
BEGIN % WAIT 1/15 SECOND BETWEEN READ RETRIES 04671350
WHILE T4 > CLOCK+P(RTR) DO SLEEP(1,1); 04671400
T4 ~ CLOCK+P(RTR)+4; 04671450
END; 04671500
IF IOQUESLOTS=0 THEN SLEEP([IOQUESLOTS],63); 04671550
IOQUESLOTS ~ IOQUESLOTS-1; 04671600
IOQUEAVAIL ~ IOQUE[T1~IOQUEAVAIL]; 04671650
IOQUE[T1] ~ IOD; 04671700
IF (T2~(T3~UNIT[U]).[FF])=@77777 THEN T3.[CF]~T1; 04671750
LOCATQUE[T1] ~ [RESULT] & MIX[3:43:5] & 04671800
U[12:42:6] & T2[CTF]; 04671850
UNIT[U] ~ T3 & T1[CTF] & 100[5:35:13]; 04671900
STARTIO(U); 04671950
FINALQUE[T1] ~ NABS(IOD) & 0[25:40:8] OR IOMASK; 04672000
RESULT ~ 0; 04672050
SLEEP([UNIT[U]],@100000000000); 04672100
IF RESULT.[30:1] THEN GO ERROROUT; % NOT READY 04672150
IF RESULT.[29:1] AND RESLT.[2:1] THEN 04672200
BEGIN 04672250
IF RESLT.[12:1] THEN % BLANK TAPE 04672300
IF IOD.[24:1] THEN % READ 04672350
TRANSACTION[U] ~ (*P(DUP))-(1 & IOD[1:22:1]) ELSE 04672400
BEGIN % WRITE 04672450
STREAM(A~TINU[U], T~T2~SPACE(3)); 04672500
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04672550
DS~21 LIT" BLANK TAPE ON WRITE~"; 04672600
END; 04672650
SPOUTER(T2,UNITNO,35); 04672700
GO ERROROUT; 04672750
END; 04672800
IF RESULT.[11:1] THEN % MEM PARITY 04672850
BEGIN 04672900
STREAM(A~TINU[U], T~T2~SPACE(3)); 04672950
BEGIN SI~LOC A; SI~SI+5; DS~3 CHR; 04673000
DS~13 LIT" I/O MEM PAR~"; 04673050
END; 04673100
SPOUTER(T2,UNITNO,35); 04673150
GO ERROROUT; 04673200
END; 04673250
IF RESULT.[13:2]!0 THEN Y ~ 18; 04673300
END ELSE 04673350
GO XIO; 04673400
END; 04673450
RESULT.[27:1] ~ 1; MODE ~ 32; 04673500
XIO: END DOIONOW; 04673550
% 04673600
U ~ SAVEU ~ OIOD.[3:4]; 04673650
% SAVE OFF ORIGINAL UNIT FOR DS-ING. 04673700
OLDU ~ UNIT[U]; 04673750
% SAVE OFF ORIGINAL UNIT TABLE ENTRY 04673800
MIX ~ RDCTABLE[U].[8:6]; 04673850
MODE ~ 16; 04673900
% SET MODE TO FLAG PARITY, MODE WILL BE SET TO ZERO IF CHANGE OK 04673950
LABELA ~ M[(TOPIOD~PRNTABLE[U].[15:15])-2] & @05000[CTF]; 04674000
FIB ~ M[TOPIOD-3]; 04674050
PBT ~ FIB[4].[8:4]=7; 04674100
FNUM ~ FIB[4].[13.11]; 04674150
BSIZE ~ IF PBT THEN 90 ELSE FIB[18].[3:15]; 04674200
NUMRECS ~ IF PBT THEN 5 ELSE BSIZE DIV FIB[18].[33:15]; 04674225
REEL ~ FIB[13].[28:10]+1; 04674250
ALFA ~ (NOT FIB[13]).[24:1]; 04674300
LABELED ~ (NOT FIB[4]).[2:1]; 04674350
NUMBUFFS ~ FIB[13].[10:9]; 04674400
TANK ~ [M[TOPIOD]] & NUMBUFFS[8:38:10]; 04674450
HALT; 04674500
% STOP NORMAL STATE PROCESSING. 04674550
IF RC THEN 04674600
IF TANK[0].[24:1] THEN 04674650
BEGIN 04674700
STREAM(T~T2~SPACE(5)); 04674750
DS ~ 40 LIT"#REEL SWITCH NOT POSSIBLE ON INPUT FILE~"; 04674800
SPOUTER(T2,UNITNO,1); 04674850
GO EXIT; 04674900
END; 04674950
STREAM(A~TINU[U], T~T2~SPACE(5)); 04675000
BEGIN 04675050
DS ~ 34 LIT"#REEL SWITCH TO BE ATTEMPTED FROM "; 04675100
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; DS ~ LIT"~"; 04675150
END; 04675200
SPOUTER(T2,UNITNO,1); 04675250
IF PBT THEN 04675300
BEGIN 04675350
LABELA.[8:10] ~ 8; % PRINTER LABELS ARE 15 WORDS 04675400
LABELA[1] ~ MULTITABLE[U].[3:45]; 04675450
LABELA[2] ~ LABELTABLE[U].[3:45]; 04675500
END; 04675550
IF RC THEN GO L1; 04675600
FIRSTREC ~ GETSPACE(BSIZE+4,0,1)+4; 04675650
SECREC ~ GETSPACE(BSIZE+4,0,1)+4; 04675700
% GETSPACE ON TWO BUFFERS FOR BACKWARD READ. 04675750
IF ALFA THEN 04675800
BEGIN 04675850
IOD ~ @340000000 & OIOD[3:3:5] & [T2][CTC]; 04675900
DOIONOW; DOIONOW; 04675950
IOD ~ OIOD & 1[24:47:1] & FIRSTREC[CTC]; 04676000
DOIONOW; 04676050
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04676100
IOD ~ IOD & SECREC[CTC]; 04676150
DOIONOW; 04676200
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04676250
IOD ~ @340000000 & OIOD[3:3:5] & [T2][CTC]; 04676300
DOIONOW; DOIONOW; 04676350
GO L1; 04676400
END; 04676450
IOD ~ OIOD & (SECREC+BSIZE-1)[CTC] & 5[22:45:3]; 04676500
DOIONOW; 04676550
% BUILD BACKWARD DESCRIPTOR AND EXECUTE FIRST BACKWARD READ. 04676600
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04676650
IF (TEMP ~ M[IOD INX 1])!BSIZE THEN 04676700
% VARIABLE LENGTH BLOCK. 04676750
SECRECIO ~ ((IOD INX 1)-TEMP) & TEMP[8:38:10]; 04676800
IOD ~ IOD & (FIRSTREC+BSIZE-1)[CTC]; 04676850
DOIONOW; 04676900
% NEXT BACKWARD READ. 04676950
IF RESULT.[27:2]!0 THEN GO ERROROUT; 04677000
IF (TEMP ~ M[IOD INX 1])!BSIZE THEN 04677050
% VARIABLE LENGTH BLOCK. 04677100
FIRSTRECIO ~ ((IOD INX 1)-TEMP) & TEMP[8:38:10]; 04677150
L1: 04677200
FOR I ~ 0 STEP 1 UNTIL NUMBUFFS-1 DO 04677250
IF (NOT TANK[I]).[19:1] THEN HOLDCT ~ HOLDCT+1; 04677300
% SCAN FOR THE NUMBER OF FILLED BUFFERS. 04677350
FIB[6] ~ FIB[6]-((RC=0)|2)-HOLDCT; 04677400
LOGICLRC ~ FIB[7] MOD NUMRECS; 04677450
% DETERMINE THE NUMBER OF LOGICAL RECORDS WRITTEN. 04677500
FIB[7] ~ FIB[6] | NUMRECS; 04677550
% LOAD FIB WITH RECORD COUNT FOR TRAILER LABEL. 04677600
IF HOLDCT=NUMBUFFS THEN 04677650
BEGIN 04677700
NOPROCESSTOG ~ NOPROCESSTOG-1; 04677750
NORMALPROCESS ~ 1; 04677800
END; 04677850
% IF THERE ARE NO UNFILLED BUFFERS THEN ALLOW NORMAL STATE 04677900
% PROCESSING TO CONTINUE. 04677950
% FLAG THE RELEASE OF NORMAL STATE. 04678000
% THE CHANCE OF UNFILLED BUFFERS IS VERY REMOTE, BUT JUST IN CASE 04678050
P1MIX ~ MIX; 04678100
% LOAD P1MIX FOR CONSOLE MESSAGES. 04678150
TEMP ~ U; 04678200
% SAVE OFF CURRENT UNIT IN CASE DS CALLED AT THIS POINT. 04678250
RETRY: 04678300
IF TERMSET(MIX) THEN 04678350
BEGIN 04678400
U ~ (-1); 04678450
GO ERROROUT; 04678500
END; 04678550
TEMP ~ U; 04678600
TM ~ @ 1737000000000000; 04678650
% TAPE MARK. 04678700
IOD ~ NFLAG([TM]) & OIOD[3:3:5]; 04678750
DOIONOW; 04678800
% WRITE TAPE-MARK. 04678850
FIB[13].[28:10] ~ REEL; 04678900
IF LABELED THEN 04678950
BEGIN 04679000
STREAM(BC~FIB[6], RC~FIB[7], BKUP~PBT, D~LABELA); 04679050
BEGIN 04679100
DI ~ DI+39; DS ~ LIT"1"; 04679150
% END OF REEL FLAG. 04679200
BKUP(DI ~ DI+12; JUMP OUT TO OWT); 04679250
SI ~ LOC BC; DS ~ 5 DEC; DS ~ 7 DEC; 04679300
OWT: DS ~ LIT"1"; 04679350
% SPECIAL FLAG FOR SORT AND USE PROCEDURES 04679400
END; 04679450
IOD ~ NFLAG(LABELA) & OIOD[3:3:5]; 04679500
IF NOT PBT THEN IF ALFA THEN 04679550
IOD.[21:1] ~ 0; 04679600
DOIONOW; 04679650
% BUILD I/O DESCRIPTOR AND WRITE THE TRAILER LABEL. 04679700
IOD ~ NFLAG([TM]) & OIOD[3:3:5]; 04679750
DOIONOW; 04679800
END; 04679850
IOD ~ IOD & @42[18:42:6]; 04679900
% BUILD THE REWIND DESCRIPTOR. 04679950
DOIONOW; 04680000
STOPTIMING(FNUM,1023); 04680050
FPB ~ PRT[MIX,3]; 04680100
LABELTABLE[U] ~ @214; % RW/L 04680150
MULTITABLE[U] ~ RDCTABLE[U] ~ PRNTABLE[U] ~ 0; 04680200
IF LABELED THEN 04680250
BEGIN 04680300
STREAM(R~REEL, BKUP~PBT, D~LABELA); 04680350
BEGIN 04680400
SI ~ LOC R; DI ~ DI+24; DS ~ 3 DEC; 04680450
% LOAD REEL NUMBER INTO LABEL. 04680500
DI ~ DI+12; DS ~ LIT"0"; 04680550
BKUP(DI ~ DI+12; JUMP OUT TO OWT); 04680600
DS ~ 12 LIT"0"; 04680650
OWT: DS ~ LIT "0"; 04680700
% CLEAN OUT OLD TRAILER LABEL INFO. 04680750
END; 04680800
IF NOT PBT THEN IF ALFA THEN 04680850
LABELA.[7:1] ~ 1; 04680900
U ~ LABELASCRATCH(LABELA); 04680950
% FIND TAPE FOR LABELED OUTPUT. 04681000
IF U=(-1) THEN GO ERROROUT; 04681050
% OPERATOR DS-ED. 04681100
END ELSE 04681150
BEGIN 04681200
U ~ FINDOUTPUT(FPB[FNUM],FPB[FNUM+1],REEL,0,0,2,0,TM); 04681250
% FIND UNLABELED OUTPUT TAPE. 04681300
IF U=(-1) THEN GO ERROROUT; 04681350
T2 ~ 0; 04681400
STREAM(PRN~PRNTABLE[U].[30:18], D~[T2]); 04681450
BEGIN SI ~ LOC PRN; DS ~ 8 DEC; 04681500
DI ~ DI-7; DS ~ 6 FILL; 04681550
END; 04681600
$ SET OMIT = PACKETS 04681650
FILEMESSAGE(" OUT" & TINU[U][6:30:18],T2, 04681800
FPB[FNUM],FPB[FNUM+1],REEL,0,0,OPNMESS); 04681850
END; 04681900
RDCTABLE[U] ~ (*P(DUP)) & MIX[8:42:6]; 04681950
PRNTABLE[U] ~ (*P(DUP)) & TOPIOD[15:33:15]; 04682000
FPB[FNUM+3].[36:6] ~ U+1; 04682050
% LOAD LOGICAL UNIT NUMBER +1 INTO FPB. 04682100
TEMP ~ OIOD.[3:4]; 04682150
% LUN OF OLD UNIT. 04682200
S ~ UNIT[TEMP].[FF]; 04682250
% SAVE OFF INDEX INTO IOQUE 04682300
UNIT[TEMP] ~ (*P(DUP)) & @77777[14:29:19]; 04682350
% CLEAR UNIT TABLE ON OLD UNIT. 04682400
UNIT[U] ~ OLDU; 04682450
% LOAD NEW UNIT TABLE ENTRY. 04682500
OIOD ~ OIOD & TINU[U][3:3:5]; 04682550
% LOAD OIOD WITH NEW UNIT NUMBER. 04682600
FOR I ~ 0 STEP 1 UNTIL NUMBUFFS-1 DO 04682650
IF TANK[I].[7:1] THEN 04682700
TANK[I] ~ (*P(DUP)) & OIOD[3:3:5]; 04682750
% LOAD NEW UNIT DESIGNATE INTO I/O DESCRIPTOR TANK. 04682800
TINU[U] ~ (*P(DUP)) & TINU[TEMP][24:24:6]; 04682850
TINU[TEMP] ~ (*P(DUP)) & 0[24:42:6]; 04682900
IF RC THEN GO KAPUT; 04682950
IF FIRSTRECIO!0 THEN IOD ~ OIOD&FIRSTRECIO[8:8:10]&FIRSTRECIO[CTC] 04683000
% TEST FOR BLOCK LESS THAN MAX LENGTH--VARIABLE LENGTH--. 04683050
ELSE IOD ~ OIOD & FIRSTREC[CTC]; 04683100
DOIONOW; 04683150
% WRITE FIRST RECORD 04683200
IF RESULT.[28:1] THEN % CHECK FOR WRITE ERROR 04683250
BEGIN 04683300
PROB: 04683350
FIB[13].[28:10] ~ REEL-1; 04683400
% DECREMENT REEL COUNT. 04683450
STREAM(A~TINU[U], T~T2~SPACE(6)); 04683500
BEGIN 04683550
DS ~ 23 LIT"#REEL SWITCH FAILED ON "; 04683600
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; 04683650
DS ~ 22 LIT", ANOTHER REEL PLEASE~"; 04683700
END; 04683750
SPOUTER(T2,UNITNO,1); 04683800
GO RETRY; 04683850
END; 04683900
IF SECRECIO!0 THEN IOD ~ OIOD&SECRECIO[8:8:10]&SECRECIO[CTC] 04683950
% CHECK FOR LESS THAN MAX LENGTH BLOCKS--VARIABLE LENGTH-- 04684000
ELSE IOD ~ OIOD & SECREC[CTC]; 04684050
% STANDARD LENGTH 04684100
DOIONOW; 04684150
% WRITE SECOND RECORD. 04684200
IF RESULT.[28:1] THEN GO PROB; 04684250
IOD ~ OIOD; 04684300
% ORIGINAL BAD IO ON NEW UNIT 04684350
DOIONOW; 04684400
IF RESULT.[28:1] THEN GO PROB; 04684450
KAPUT: 04684500
IF NOT DSED THEN 04684550
BEGIN 04684600
MODE ~ 0; 04684650
STARTIMING(FNUM,U); 04684700
END; 04684750
% CHANGE OVER SUCCESSFUL. 04684800
FIB[15].[24:6] ~ U; 04684850
% NEW LUN INTO FIB. 04684900
OLDU ~ TINU[U].[3:5]; 04684950
% OLDU LOADED WITH NEW PHYSICAL UNIT NUMBER. 04685000
IF NOT RC THEN 04685050
BEGIN 04685100
RESETUNITS: 04685150
IOQUE[S] ~ (*P(DUP)) & OLDU[3:43:5]; 04685200
FINALQUE[S] ~ (*P(DUP)) & OLDU[3:43:5]; 04685250
LOCATQUE[S] ~ (*P(DUP)) & U[12:42:6]; 04685300
% RESET DESCRIPTORS IN IOQUE. 04685350
IF (S ~ LOCATQUE[S].[FF]!@77777 THEN GO RESETUNITS; 04685400
END; 04685450
FIB[16] ~ (*P(DUP)) & OLDU[3:43:5]; 04685500
FIB[19] ~ (*P(DUP)) & OLDU[3:43:5]; 04685550
% CHANGE UNIT FIELD OF DESCRIPTORS IN FIB. 04685600
FIB[6] ~ ((RC=0)|2)+HOLDCT; 04685650
% LOAD NEW BLOCK COUNT INTO FIB 04685700
FIB[7] ~ (((RC=0)|2) | NUMRECS)+HOLDCT | NUMRECS+LOGICLRC; 04685750
% LOAD NEW RECORD COUNT 04685800
TINU[U].[24:6] ~ 0; 04685850
UNIT[U].[5:10] ~ 0; 04685900
% RESET ERROR FLAGS. 04685950
IF NOT DSED THEN 04686000
BEGIN 04686050
STREAM(A~TINU[U], T~T2~SPACE(4)); 04686100
BEGIN 04686150
DS ~ 26 LIT"#REEL SWITCH COMPLETED ON "; 04686200
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; DS ~ LIT"~"; 04686250
END; 04686300
SPOUTER(T2,UNITNO,1); 04686350
END; 04686400
TOPIOD ~ TEMP ~ (IF RC THEN FIB[19] ELSE OIOD).[CF]-2; 04686450
% MUST RESET LUN IN I/O BUFFER FOR PROGRAM RELEASE 04686500
ARN: M[TEMP] ~ (*P(DUP)) & U[12:42:6]; 04686550
IF M[TEMP].[FF]-2!TOPIOD THEN 04686600
BEGIN 04686650
TEMP ~ M[TEMP].[FF]-2; 04686700
GO ARN; 04686750
END; 04686800
GO EXIT; 04686850
ERROROUT: 04686900
STREAM(T~T2~SPACE(3)); 04686950
DS ~ 21 LIT"#REEL SWITCH ABORTED~"; 04687000
SPOUTER(T2,UNITNO,1); 04687050
IF U < 0 THEN % JOB BEING DS-ED AT MT REQ 04687100
BEGIN 04687150
U ~ TEMP; 04687200
% SET U TO LAST UNIT. 04687250
IF U=SAVEU THEN GO EXIT; 04687300
DSED ~ 1; 04687350
GO KAPUT; 04687400
% GO TO KAPUT TO COUNTINUE HOUSE-KEEPING 04687450
END; 04687500
EXIT: 04687550
P1MIX ~ 0; 04687600
IF FIRSTREC!0 THEN 04687650
BEGIN 04687700
FORGETSPACE(FIRSTREC-2); 04687750
FORGETSPACE(SECREC-2); 04687800
END; 04687850
IF NOT NORMALPROCESS THEN NOPROCESSTOG ~ NOPROCESSTOG-1; 04687900
% WAS UNABLE TO FREE NORMAL PROCESS DUE TO UNFILLED BUFFERS. 04687950
% THIS SITUATION MAY NEVER OCCUR, BUT JUST IN CASE 04688000
WRITEPARITYREELSWITCH ~ UNIT[U] & MODE[5:40:8]; 04688050
END WRITEPARITYREELSWITCH; 04688100
REAL PROCEDURE PLACEFINDER(S, A, L); 04700000
VALUE S, A; 04701000
REAL S, A, L; 04702000
BEGIN INTEGER I; ARRAY B[*]; 04703000
REAL T, W, E, J, AA; 04704000
LABEL NULL, FOUND, EXIT; 04705000
LABEL SANDA; REAL SS; 04705500
W ~ -1; 04706000
B ~ [M[T ~ SPACE(30)]]&30[8:38:10]; 04707000
SS:=S; 04707500
IF S=0 THEN 04708000
NULL: BEGIN STREAM(T); DS:=20 LIT " "; GO EXIT; END; 04709000
DISKWAIT(-T,30,JAR[P1MIX,10]); 04710000
IF (JAR[P1MIX,10]=0) OR (AA~B[0].[FF])=0 THEN 04711000
SANDA: BEGIN STREAM(S:=SS,A,K:=M[PRT[P1MIX,8]].[10:2],T); 04712000
BEGIN DS~5 LIT ", S ="; 04713000
SI~LOC S; DS~4 DEC; 04714000
DS~5 LIT ", A ="; 04715000
DS~4 DEC; 04716000
DS:=LIT ":"; SI:=SI+7; DS:=CHR; 04716100
DI~T; DI~DI+5; DS~3 FILL; 04717000
DI~T; DI~DI+14; DS~3 FILL; 04718000
END STREAM; 04719000
GO EXIT; 04720000
END; 04721000
DISKWAIT(-T,30,I:=JAR[P1MIX,AA DIV JAR[P1MIX,8]+10+ 04722000
AA MOD JAR[P1MIX,8]+S DIV 30); 04723000
IF (J~B[S MOD 30])<0 THEN GO TO NULL; 04725000
AA ~ I ~ JAR[P1MIX,J.[CF] DIV JAR[P1MIX,8]+10]+ 04726000
J.[CF] MOD JAR[P1MIX,8]; 04727000
I~0; J~J.[FF]; 04728000
DO BEGIN S~(I+J).[36:11]; 04729000
IF W!(W:=S DIV 30) THEN DISKWAIT(-T,30,AA+W); 04731000
IF (E ~ B[S-W|30].[38:10])=A THEN GO TO FOUND; 04732000
IF E<A THEN I~S ELSE J~S; 04733000
END UNTIL J-I=1; 04734000
S~I; 04735000
FOUND: L ~ -B[S MOD 30].[28:10]; 04736000
IF L=0 THEN GO TO SANDA; 04736500
STREAM(L~ABS(L),T); 04737000
BEGIN DS:=11 LIT ",NEAR LINE "; 04738000
SI~LOC L; DS~8 DEC; 04739000
DS:=LIT " "; DI:=DI-9; DS:=7 FILL; 04740000
END STREAM; 04741000
EXIT: PLACEFINDER ~ T; 04742000
END PLACEFINDER; 04743000
$ SET OMIT = NOT(DATACOM ) 04999999
PROCEDURE LOGOUT(A); VALUE A; REAL A; FORWARD; %154-05606900
PROCEDURE FORMTIME(W,T); VALUE W,T; REAL W,T; %154-05607000
BEGIN INTEGER S,M; %154-05608000
T~(T+60) DIV 60; %154-05609000
S~T MOD 60; %154-05610000
T~T DIV 60; %154-05611000
M~T MOD 60; %154-05612000
T~T DIV 60; %154-05613000
STREAM(T,M,S,W~[W]); %154-05614000
BEGIN SI~LOC T; DS~2 DEC; %154-05615000
2(DS~LIT ":"; DS~2 DEC); %154-05616000
DI~W; DS~7 FILL; %154-05617000
END; %154-05618000
END; %154-05619000
PROCEDURE LOGSPACE(W,L); % THIS MAY ZIP 05700000
VALUE W,L; NAME W; INTEGER L; % FIRST WORD,WORD COUNT 05701000
COMMENT THIS WILL CLOBBER WORDS AROUND THOSE LOGGED; 05701010
BEGIN INTEGER B,I,J,K,N; ARRAY A[*]; LABEL OK; DEFINE Z=LOGFREE#; 05702000
N~L DIV 5; %NO REMAINDER ALLOWED 05702500
A:=[M[B:=SPACE(30)]]&30[8:38:10]; 05703000
IF Z>0 THEN SLEEP([Z],-0); Z~-Z; 05703500
$ SET OMIT = NOT(SHAREDISK) 05703699
DISKWAIT(-B,30,Z); 05704000
IF (I~A[0])+6+N}(J~A[1]) THEN BEGIN I~0; K~1 END %WRAP AROUND 05705000
ELSE IF I+N+100 GEQ J THEN 05706000
BEGIN INDEPENDTRUNNER(P(.LOGOUT),1,128); 05706100
K:=2; 05706200
END 05706300
ELSE IF I<J DIV 2 AND J DIV 2<I+N THEN K~3 % HALF FULL 05707000
ELSE GO TO OK; 05708000
STREAM(K:=K-1, J:=J:=SPACE(3)); 05709000
BEGIN CI:=CI+K; GO TO L2; GO TO L1; 05710000
DS:=14 LIT"#LOG HALF FULL"; GO TO L3; 05710500
L1: DS:=19 LIT" LOG FULL - AUTO LN"; GO TO L3; 05711000
L2: DS:=17 LIT"**LOG WRAP AROUND"; 05711500
L3: DS:=LIT"~"; 05712000
END; 05713000
SPOUT(J); 05714000
OK: A[0]~N+I; A[3]~K; A[2]~I~I+1; %WE NOW PUT THE WORDS IN I 05715000
W[L]~4; % END OF LOG 05715100
J~(I MOD 6)|5; %SIZE OF NEIGHBORHOOD (NBD) 05716000
$ SET OMIT = NOT(SHAREDISK) 05716999
IF (I~I DIV 6)!0 THEN DISKWAIT(B,30,Z); %DUMP RECORD ZERO 05722000
IF J!0 THEN % GET NBD 05723000
BEGIN IF I!0 THEN DISKWAIT(-B,30,Z+I); 05724000
MOVE(30-J,W INX 0,A INX J) 05725000
END 05726000
ELSE B:=W INX 0; 05727000
DISKWAIT(B,30,Z+I); 05728000
IF (L+J) GEQ 30 THEN 05728100
BEGIN K:=L-(J:=30-J)+1; 05728120
I:=I+1; 05728140
DO 05728160
BEGIN DISKWAIT(W INX J,IF K>1020 THEN 1020 ELSE K,Z+I); 05728180
J:=J+1020; 05728200
I:=I+34; 05728220
END UNTIL (K:=K-1020) LEQ 0; 05728240
END; 05728260
$ SET OMIT = NOT(STATISTICS) 05728299
FORGETSPACE(A); 05729000
$ SET OMIT = NOT(SHAREDISK ) 05729199
Z:=-Z; 05729300
END OF LOGSPACE; 05730000
DEFINE 05780000
MAXSIZ[1:20]#, TOMAXSIZ=1:28:20#, 05780010
SPEED = [23:3]#, TOSPEED= 23:45:3#, 05780020
EUNP = [21:1]#, TOENUP = 21:47:1#, 05780025
STARTWRD=[26:12]#, TOSTARTWRD=26:36:12#, 05780030
NUMENT=[38:10]#, TONUMENT=38:38:10#, NUMENTM=1023#, 05780040
DSIZE=[2:20]#, TODSIZE=2:28:20#, 05780100
DENT=[22:26]#, TODEND=22:22:26#, 05780200
TOSIZE=8:38:10#, NEUF=[18:15]#, 05780300
EUIOFFSET=4 #, % ONE WORD FOR EACH I/O CHANNEL. 05780310
AVDIFFMIN=15#, AVDIFFMAX=50#, % AVDIFFMAX GTR AVDIFFMIN GTR 14. 05780400
AVTMAX=3900#, % MAX # WORDS ALLOWED FOR AVAILABLE TABLE ON DISK. 05780500
% IS REFLECTED IN USERDISKBOTTOM & DISKAVAILTABLEMAX05780505
AVSMIN=90# , AVSMAX=300#, % MIN AND MAX # WORDS TO READ IN @ 1 TIM05780600
% AVSMAX GTR AVSMIN GTR 85 05780605
% BOTH MUST BE MULTIPLES OF 30 05780610
FIXARRAY(FIXARRAY1,FIXARRAY2,FIXARRAY3)=FIXARRAY1~[M[FIXARRAY2~ 05780700
SPACE(FIXARRAY3)]]&FIXARRAY3[TOSIZE]# ; 05780800
$ SET OMIT = NOT (SHAREDISK ) 05800000
REAL PROCEDURE PETUSERDISK(N,T); VALUE N,T; REAL N,T ; 05839400
% N IS THE NUMBER OF SEGMENTS REQUESTED, AND T IS THE EU# OR THE SPEED#.05839600
% GETUSERDISK WILL RETURN -1, 0, OR THE ABSOLUTE DISK SEGMENT ADDRESS OF05839700
% THE RESULTANT AREA. SEE T.[2:1] FOR THE -1, AND N.[2:1] FOR THE 0. 05839800
% T>0 => T IS A PREFERRED SPEED#: T=1,2,3,4,..., OR 31. 05840000
% T<0 => -T IS A PREFERRED EU#: T=-1,-2,-3,-4,..., OR -20. 05840100
% T=0 => DONT CARE ABOUT SPEED# OR EU#, USE EU WITH LEAST EU I/O. 05840200
% T.[2:1]=1 => IF CANT GET PREFERRED SPEED# OR EU#, RETURN -1. 05840300
% T.[2:1]=0 => IF CANT GET PREFERRED SPEED# OR EU#, TREAT AS T=0 (ABOVE)05840400
% N>0 => MAKE A SCRATCHDIRECTORY ENTRY. 05840500
% N<0 => DONT MAKE A SCRATCHDIRECTORY ENTRY. 05840600
% N=0 => IMMEDIATELY RETURN WITH A 0. 05840700
% N.[2:1]=0 => IF CANT FIND ANY USERDISK, AND T.[2:1]=0, NO-USER-DISK. 05840800
% N.[2:1]=1 => IF CAND FIND ANY USERDISK, ANT T.[2:1]=0, RETURN 0. 05840900
BEGIN 05841200
INTEGER K=+1, % K IS ALSO "GETUSERDISK"; DONT USE K ABOVE LABEL D. 05841300
Z=K+1, NS=Z+1, I=NS+1, 05841350
$ SET OMIT = NOT(SHAREDISK ) 05841380
$ SET OMIT = SHAREDISK 05841610
R=I+1, AVS=R+1, H=NT6, L=AVS ; 05841615
REAL M1=NT5 M2=NT4,; ARRAY UT=J+1[*]; DEFINE U=AVTABLE # ; 05841620
$ POP OMIT 05841621
LABEL A,B,C,D,E,F,G,W ; 05841650
DEFINE GETUSERDISK=PETUSERDISK#;%***************************************05841700
IF N=0 THEN GO W ; 05842100
P(T.[2:1],ABS(N),1,0,0,0,0) ; 05842200
$ SET OMIT = NOT(SHAREDISK ) 05842205
A: SLEEP([TOGGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 05842300
$ SET OMIT = NOT(SHAREDISK ) 05842390
$ SET OMIT = SHAREDISK 05842405
M1:=M2:=P(D) ; 05842410
$ POP OMIT 05842411
L:=NEUP.NEUF ; 05842450
IF T LSS 0 THEN IF U[J:=IF -T GTR L THEN L+1 ELSE -T].MAXSIZ GEQ NS 05842475
THEN GO E ELSE IF Z THEN GO C ; 05842500
B: IF U[I].MAXSIZ}NS THEN 05842700
BEGIN 05842800
P(EUIO[(NT1:=I-1)+EUIOFFSET]+PEUIO[NT1],.NT2,SND,DUP) ; 05842900
IF P LSS M1 THEN BEGIN M1:=NT2; H:=NT1 END ; 05842930
IF P LSS M2 THEN IF UPI[.SPPED=T THEN BEGIN M2:=NT2;J:=NT1 END;05843000
END; 05843100
IF (I:=I+1) LEQ L THEN GO B ; 05843200
IF P(D)!M1 THEN 05843300
BEGIN 05843400
IF M2=M2:=P(D) THEN IF Z AND T!0 THEN 05843500
C: BEGIN GETUSERDISK~-1; GO G END 05843600
ELSE J~H ; 05843700
J:=J+1; GO E ; 05843800
END; 05843900
IF Z THEN GO C ; 05843950
IF N.[2:1] THEN GO G ; 05844000
$ SET OMIT = NOT(SHAREDISK ) 05844050
$ SET OMIT = SHAREDISK 05844090
FIXARRAY(UT,R,30); USERDISKSPECIALCASE(I:=1,R,UT,NS); GO A ; 05844110
$ POP OMIT 05844111
D:::@0777777777777777 ; 05844200
$ SET OMIT = NOT(SHAREDISK ) 05844290
$ SET OMIT = SHAREDISK 05844915
E: IF (AVS:=(K:=(T:=U[J] AND NUMENTM)+I:=(Z:=U[J].STARTWRD) MOD 30) MOD05844920
30) NEQ 0 THEN AVS:=30-AVS; AVS:=AVS+K; P(M2) ; 05844925
FIXARRAY(UT,R,AVS); DISKWAIT(-R,AVS,Z~Z DIV 30+USERDISKBOTTOM) ; 05844930
M2:=P; P(K-1); NT2:=0; NT3:=K:=U[J].MAXSIZ ; 05844935
$ POP OMIT 05844936
E: IF (NT1~UT[I].DSIZE)>NT2 THEN IF NT1!K THEN NT2~NT1 ELSE K:=0; 05845000
IF NT1}NS THEN IF NT1<M2 THEN BEGIN M2~NT1; H~I END ; 05845100
IF P(DUP) GTR I:=I+1 THEN GO F ; 05845200
UT[H].DSIZE~NS~M2-NS ; 05845300
IF M1:=M2=NT3 THEN U[J].MAXSIZ:=IF NT2>NS THEN NT2 ELSE NS ; 05845400
GETUSERDISK~UT[H].DEND-M2; I:=P ; 05845500
$ SET OMIT = NOT(SHAREDISK ) 05845590
IF N~NS=0 THEN BEGIN MOVE(I-H,[UT[H+1]],[UT[H]]);U[J].NUMENT~T-1END;05845700
$ SET OMIT = NOT(SHAREDISK ) 05845790
$ SET OMIT = SHAREDISK 05846350
DISKWAIT(R,AVS,Z); 05846360
$ POP OMIT 05846361
$ SET OMIT = NOT(SHAREDISK ) 05846370
$ SET OMIT = SHAREDISK 05846385
FORGETSPACE(R) ; 05846390
G: UNLOCKTOG(USERDISKMASK); 05846395
$ POP OMIT 05846396
W: END OF GETUSERDISK ; 05846500
PROCEDURE FORGETUSERDISK(A,N); VALUE A,N; REAL A,N ; 05846600
% A IS THE ABSOLUTE DISK SEGMENT ADDRESS OF AN AREA N SEGMENTS LONG 05846800
% WHICH IS TO BE MADE AVAILABLE AGAIN. 05846900
% N<0 => MAKE A SCRATCHDIRECTORY DELETION. 05847000
% N>0 => DONT MAKE A SCRATCHDIRECTORY DELETION. 05847100
% N=0 => IMMEDIATELY GO AWAY ; 05847200
BEGIN 05847400
$ SET OMIT = NOT(SHAREDISK ) 05847490
$ SET OMIT = SHAREDISK 05847590
INTEGER AVS,F=AVS; ARRAY UT[*]; DEFINE U=AVTABLE #; 05847600
$ POP OMIT 05847601
REAL E; INTEGER B,C,D,I,J,R,S,H=NT7,K=NT6,L=NT5,G=NT4,T=NT3,Q=JUNK;05847700
LABEL V,W,X,Y,Z,AZ,BZ,CZ,DZ ; 05847800
SUBROUTINE SETSHIFT ; 05847900
BEGIN 05848000
S:=P(XCH) ; 05848100
$ SET OMIT = NOT(SHAREDISK ) 05848190
$ SET OMIT = SHAREDISK 05848250
U[J].STARTWRD:=I+S; G:=D+S; 05848255
$ POP OMIT 05848256
K:=G+C-1; 05848300
END OF SETSHIFT; 05848500
IF N=0 OR (J:=A DIV 1000000) GEQ NEUP.NEUF 05848900
OR A LSS USERDISKBOTTOM+DISKAVAILTABLEMAX THEN GO BZ ; 05849000
SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 05849300
$ SET OMIT = NOT(SHAREDISK ) 05849390
IF (D:=U[0].MAXSIZ) NEQ 0 AND N GTR 0 THEN IF (TWO(J) AND D) NEQ 0 05849420
THEN BEGIN USERDISKSPECIALCASE(3,N,U,A); IF NOT P THEN GO DZ END ; 05849460
J:=J+1 ; 05849480
V: D~(I~(E~U[J]).STARTWRD) MOD 30 ; 05849500
$ SET OMIT = NOT(SHAREDISK ) 05849590
$ SET OMIT = SHAREDISK 05850105
AVS:=30-(S:=(C:=E AND NUMENTM)+D) MOD 30+S ; 05850110
FIXARRAY(UT,R,AVS); DISKWAIT(-R,AVS,B:=I DIV 30+USERDISKBOTTOM) ; 05850120
K:=S; L:=D; S:=I+C ; 05850130
$ POP OMIT 05850131
G~I-(NT2:=(P(U[J-1],DUP) AND NUMENTM)+P(XCH).STARTWRD) ; 05850200
S~U[J+1].STARTWRD-S; H~K~K-1; IF UT[T~L].DEND}A THEN GO X ; 05850300
W: IF UT[T~(H+L+1)DIV 2].DEND}A THEN IF UT[H~T-1].DEND}A THEN GO W ELSE05850400
ELSE IF UT[T~T+1].DEND<A THEN BEGIN L~T+1; GO W END ; 05850500
X: IF (L:=A+ABS(N)) GEQ H:=P(UT[Q:=T],DUP).DEND-P(XCH).DSIZE THEN GO Z;05850600
IF S=0 THEN 05850700
BEGIN 05850800
$ SET OMIT = NOT(SHAREDISK ) 05850890
$ SET OMIT = SHAREDISK 05851215
IF G=0 OR D=0 THEN GO Y; IF P((G+1)DIV 2,DUP)>0 THEN P(DEL,D);05851220
$ POP OMIT 05851221
P(SSN);SETSHIFT;MOVE(C,[UT[G-S]],[UT[G]]);T~Q~T+S; 05851300
END; 05851400
FOR H~K STEP -1 UNTIL T DO UT[H+1]~UT[H]; H~ABS(N); GO AZ ; 05851500
Y: USERDISKSPECIALCASE(2,E,UT,J) ; 05851600
$ SET OMIT = NOT(SHAREDISK ) 05851650
GO V ; 05851675
Z: IF P(UT[Q~Q+1],DUP).DEND=P(XCH).DSIZE{L THEN GO Z ; 05851700
IF P(UT[NT1:=Q-1].DEND,DUP) LSS L THEN P(DEL,L) ; 05851800
H:=(L:=P)-(IF A LSS H THEN A ELSE H) ; 05851850
IF NT1 GTR T THEN MOVE(K-NT1,[UT[Q]],[UT[T+1]]) ; 05851900
AZ: UT[T]~L&H[TODSIZE]; C~(Q~T-Q+1)+C ; 05852000
IF(S~S-Q)>T~IF AVDIFFMAX>T~C DIV 2 THEN AVDIFFMAX ELSE T THEN IF J=105852100
OR S+G>T+(IF AVDIFFMAX>T~NT2 DIV 2 THEN AVDIFFMAX ELSE T) THEN GO Y 05852200
ELSE BEGIN 05852300
IF (NT1~F-1-K)=0 THEN GO Y; 05852350
IF P((S+G) DIV 2,DUP) GTR NT1 THEN P(DEL,NT1);SETSHIFT; 05852400
FOR NT1~K STEP -1 UNTIL G DO UT[NT1]~UT[NT1-S] ; 05852500
END ; 05852600
U[J]~(NT1~U[J])&C[TONUMENT]&(IF E~(NT1~NT1.MAXSIZ)<H THEN H ELSE 05852700
NT1)[TOMAXSIZ] ; 05852800
$ SET OMIT = NOT(SHAREDISK ) 05852890
$ SET OMIT = SHAREDISK 05853420
DISKWAIT(R,AVS,B) ; 05853425
$ POP OMIT 05853426
$ SET OMIT = NOT(SHAREDISK ) 05853490
$ SET OMIT = SHAREDISK 05853593
FORGETSPACE(R) ; 05853595
DZ: UNLOCKTOG(USERDISKMASK); 05853600
$ POP OMIT 05853601
BZ: END OF FORGETUSERDISK ; 05853700
PROCEDURE DKBUSINESS(BUFF); VALUE BUFF; REAL BUFF; 05950000
BEGIN 05950200
REAL RCW=+0, 05950400
MSCW=-2, 05950500
MID=RWC+1, 05950600
FID=MID+1, 05950800
TMID=FID+1, 05950900
IFID=TMID+1, 05950950
A=TFID+1, 05951000
B=A+1; 05951200
INTEGER N=B+1; 05951400
ARRAY HD=N+1[*]; 05951600
BOOLEAN RDT=HD+1; 05951700
INTEGER C=RDT+1,D=C+1,I=D+1,J=I+1,R=J+1,S=R+1, 05951800
LA=S+1,SA1=NT2, 05951900
H=NT7,K=NT6,L=NT5,G=NT4,T=NT3,Q=JUNK; 05952000
REAL E=LA+1; 05952200
REAL KTR=B; 05952210
REAL TYPE=C; 05952220
REAL WORD=D; 05952230
REAL HA=J; 05952240
REAL HEADER=R; 05952250
ARRAY HDR=E[*]; 05952260
BOOLEAN FILTOG=E+1; 05952270
REAL SEGS=FILTOG+1; 05952300
$ SET OMIT = SHAREDISK 05952399
ARRAY UT=HD[*]; INTEGER AVS=SEGS+1; DEFINE U=AVTABLE#; 05952400
INTEGER SLEEPER=AVS+1; 05952500
$ POP OMIT 05952501
$ SET OMIT = NOT(SHAREDISK) 05952505
LABEL V,W,X,Y,Z,AZ,BZ,CZ,INUSE,EXIT; 05952600
LABEL FILEID,XDFILE,CONFLICT,FOUND,MSG,FINIS; 05952620
$ SET OMIT = NOT(SHAREDISK) 05952690
REAL SUBROUTINE DECWORD; 05952705
BEGIN 05952710
STREAM(T~0:W~[WORD]); 05952715
BEGIN 05952720
SI~W; DI~LOC T; DS~8DEC; 05952725
END STREAM; 05952730
DECWORD~P; 05952735
END DECWORD; 05952740
SUBROUTINE SCAN; 05952745
BEGIN 05952750
STREAM(KTR,TYPE~0:T~0,W~[WORD]); 05952755
BEGIN 05952760
SI~KTR; 05952765
L0: IF SC=" " THEN BEGIN SI~SI+1; GO L0; END; 05952770
IF SC=""" THEN % STRING IDENTIFIER 05952775
BEGIN 05952780
SI~SI+1; DS~LIT"0"; 05952785
IF SC=""" THEN 05952790
BEGIN 05952795
SI~SI+1; 05952800
IF SC=""" THEN DS~CHR ELSE DS~LIT" "; 05952805
DS~6LIT" "; 05952810
END ELSE 05952815
BEGIN 05952820
7(IF SC!""" THEN DS~CHR ELSE DS~LIT" "); 05952825
L1: IF SC~""" THEN BEGIN SI~SI+1; GO L1; END; 05952830
S1~SI+1; 05952835
END; 05952840
GO T1; 05952845
END; 05952850
IF SC=ALPHA THEN IF SC LSS "0" THEN 05952855
BEGIN % IDENTIFIER 05952860
ID: DS~LIT"0"; 05952865
7(IF SC=ALPHA THEN DS~CHR ELSE DS~LIT" "); 05952870
L2: IF SC=ALPHA THEN BEGIN SI~SI+1; GO L2; END; 05952875
T1: TALLY~1; 05952880
GO EXT; 05952885
END; 05952890
IF SC=ALPHA THEN IF SC LEQ "9" THEN 05952895
BEGIN % NUMBER 05952900
SI~SI+1; TALLY~1; 05952905
7(IF SC=ALPHA THEN IF SC LSS "0" THEN 05952910
BEGIN T~TALLY; SI~SI-T; JUMP OUT TO ID; END 05952915
ELSE IF SC LEQ "9" THEN 05952920
BEGIN SI~SI+1; TALLY~TALLY+1; END); 05952925
T~TALLY; SI~SI-T; DS~T OCT; 05952930
TALLY~2; 05952935
GO EXT; 05952940
END; 05952945
IF SC!"~" THEN TALLY~3 ELSE TALLY~5; 05952950
DS~7 LIT"0"; DS~CHR; 05952955
EXT: TYPE~TALLY; 05952960
KTR~SI; 05952965
END STREAM; 05952970
P(.TYPE,STD,.KTR,STD); 05952975
END SCAN; 05952980
SUBROUTINE MLOGIT; 05952985
BEGIN 05952990
S~TYPEDSPACE(15,MAINTBUFFAREAV);% %167-05952995
STREAM(B:DATE,D~S+1); 05953000
BEGIN 05953005
SI~LOC DATE; DS~8 OCT; DI~DI+8; 05953010
SI~B; 05953015
2(63(IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 TO LL)); 05953020
LL: DS~LIT"~"; DI~DI-1; B~DI; 05953025
END STREAM; 05953030
LA~ P INX 0; 05953035
M[S]~ (LA-S) DIV 5; 05953040
M[S+2]~IF FILTOG THEN -N ELSE SEGS; 05953045
LINKUP(18,S); 05953050
END MLOGIT; 05953055
SUBROUTINE ENTERFILE; 05953060
BEGIN 05953065
FIXARRAY(HD,B,30); 05953070
MOVE(30,HD-1,HD); 05953075
HD[0]~@3600036000101; 05953080
STREAM(DATE,XCLOCK,H~HD INX 3); 05953085
BEGIN 05953090
SI~LOC DATE; DS~8OCT; 05953095
DI~DI-20; SI~SI+4; DS~4CHR; 05953100
DI~DI-7; SI~H; SI~SI+5; DS~3CHR; 05953105
DI~H; DS~2LIT"+#"; SI~SI-3; DS~3CHR; 05953110
END STREAM; 05953115
HD[4].[42:1]:=1; % MAKE FILE NON-MOVEABLE 05953117
HD[7]~(HD[8]~N)-(HD[9]~1); 05953120
HD[10]~A; 05953125
ENTERUSERFILE(MID,FID.[6:42],B-1); 05953130
STREAM(MID,FID,N,TMID,TFID,FILTON, 05953135
B~IF FILTOG THEN B ELSE BUFF); 05953140
BEGIN 05953145
SI~LOC N; DI~LOC N; DS~8DEC; 05953150
DI~LOC N; DS~7FILL; DI~B; 05953155
DS~LIT" "; SI~LOC MID; SI~SI+1; DS~7CHR; 05953160
DS~LIT"/"; SI~SI+1; DS~7CHR; 05953165
DS~6LIT" SEGS="; DS~8CHR; DS~8LIT" CREATED"; 05953170
FILTOG(DS~6LIT" FROM "; DI~SI+1; DS~7CHR; 05953175
DS~LIT"/"; SI~SI+1; DS~7CHR); 05953180
DS~LIT"~"; 05953185
END STREAM; 05953190
IF FILTOG THEN 05953195
BEGIN 05953200
MLOGIT; 05953205
SPOUT(B); 05953210
END ELSE 05953215
FORGETSPACE(B); 05953220
END ENTERFILE; 05953225
P(0,0,0,0,0,BUFF,DUP); BUFF~P.[15:15]-1; P(0,0,B LSS 0); 05953250
P(0,0,0,0,0,0,0,0,0,0,0); 05953260
$ SET OMIT = NOT(SHAREDISK); 05953269
IF B.[CF]=0 THEN% MAKE RESERVE/DISK 05953400
BEGIN MID:="RESERVE"; FID:="DISK "; 05953600
IF (A:=DIRECTORYSEARCH(-MID,FID,5))!0 THEN 05953800
BEGIN STREAM(BUFF); 05954000
DS:=30LIT" RESERVE/DISK ALREADY PRESENT~"; 05954200
GO TO EXIT; 05954400
END; 05954600
IF (A~GETUSERDISK((N~RESERVEDISKSIZE)&1[2:47:1]))=0 THEN 05954800
BEGIN STREAM(BUFF); 05955000
DS:=32LIT"**NO USER DISK FOR RESERVE/DISK~"; 05955200
GO TO EXIT; 05955400
END; 05955600
GO TO CZ; 05955800
END; 05956000
IF RDT THEN 05956250
BEGIN P(B); A:=M[BUFF INX 0]; N:=M[BUFF INX 1]; END ELSE 05956300
BEGIN 05956350
SCAN; 05956400
IF TYPE=1 THEN % IDENTIFIER 05956450
BEGIN 05956500
TMID~WORD; 05956550
SCAN; IF WORD!"/" THEN GO EXIT; 05956600
FILEID: 05956650
SCAN; IF NOT TYPE=1 OR TYPE=2) THEN GO EXIT; 05956700
IF ID~IF TYPE=2 THEN DECWORD ELSE WORD; 05956750
FILTOG~TRUE; 05956800
SCAN; 05956850
END; 05956900
IF TYPE=2 THEN % NUMBER 05956950
BEGIN 05957000
A~WORD; 05957050
SCAN; 05957100
IF TYPE=3 THEN IF WORD="/" THEN 05957150
BEGIN 05957200
WORD~A; 05957250
A~0; 05957300
TMID~DECWORD; 05957350
GO FILEID; 05957400
END ELSE SCAN; 05957450
IF TYPE=2 THEN N~WORD; 05957500
END; 05957550
END; 05957600
SEGS~N~N+(N=0); 05957650
IF (A!0) THEN 05957700
BEGIN 05957750
STREAM(A,D:=[FID]); 05958600
BEGIN SI:=LOC A; DS:=8 DEC; END; 05958800
IF (J:=A DIV 1000000) GEQ NEUP.NEUF OR A LSS DIRECTORYTOP+4 THEN 05959000
V: BEGIN STREAM(FID,BUFF); 05959200
BEGIN DS:=22LIT" INVALID DISK ADDRESS "; 05959400
SI:=LOC FID; DS:=8CHR; DS:=LIT"~"; 05959600
DI:=DI=9; DS:=7 FILL; 05959800
END; 05960000
GO TO EXIT; 05960200
END; 05960400
IF WAITIO([FID]INX@100000000,@64,18+FID.[5:1]).[42:1] THEN GO TO V; 05960600
IF (R:=FID.[12:6]) GEQ 2 THEN % CHECK FOR 40 MIL ADDRESS 05960650
IF NOT WAITIO([FID]INX @140000000,@64,18+FID.[5:1]).[43:1] 05960660
THEN GO TO V ELSE IF R GEQ 4 THEN GO TO V;% INV ADD 05960670
END; 05960675
IF FILTOG THEN GO XDFILE; 05960680
IF A=0 THEN GO EXIT; 05960685
SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 05960700
$ SET OMIT = NOT(SHAREDISK) 05960705
J~J+1; 05960800
BZ: D:=(I:=(E:=U[J]).STARTWRD) MOD 30; 05961000
$ SET OMIT = NOT(SHAREDISK) 05961005
$ SET OMIT = SHAREDISK 05961199
AVS:=30-(S:=(C:=E AND NUMENTM)+D)MOD 30+S; 05961200
FIXARRAY(UT,R,AVS); DISKWAIT(-R,AVS,B:=I DIV 30+USERDISKBOTTOM); 05961400
K:=S; I:=D; S:=I+C; 05961600
$ POP OMIT 05961601
G:=I-(NT2:=(P(U[J-1],DUP) AND NUMENTM)+P(XCH).STARTWRD); 05961800
S:=U[J+1].STARTWRD-S; H:=K:=K-1; IF UT[T:=L].DEND GTR A THEN GO X; 05962000
W: IF UT[T+(H+L+1) DIV 2].DEND > A THEN IF UT[H~T-1].DEND > A THEN GO W05962200
ELSE ELSE IF UT[T~T+1].DEND { A THEN BEGIN L~T+1; GO W END; 05962400
X: IF A GEQ L:=(H:=UT[T].DEND)-(Q:=UT[T].DSIZE) THEN 05962600
IF (LA:=(A+N)) LEQ H THEN GO AZ%AREA AVAILABLE 05962700
ELSE IF LA LEQ SA1:=(UT[T+1].DEND-UT[T+1].DSIZE) THEN 05962800
N:=LA-A:=H ELSE N:=SA1-A:=H ELSE IF (LA:=A+N) GTR L THEN 05962900
N:=L-A ELSE RDT:=RDT OR @100000; 05963000
GO INUSE; 05963100
Y: TMID:=IF RDT THEN "DKTEST " ELSE "BADISK "; 05963800
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05963809
STREAM(TMID,FID,N,MID,B,BUFF); 05964000
BEGIN DS:=LIT "."; SI:=LOC TMID; SI:=SI+1; DS:=7 CHR; 05964200
DS:=LIT "/"; SI:=SI-1; DS:=7 CHR; 05964400
DS:=13 LIT " NOT CREATED("; SI:=SI+8; SKIP SB; 05964500
IF SB THEN ELSE 05964600
BEGIN SI:=LOC N; DS:=7 DEC; N:=DI; DI:=DI-7; DS:=7 FILL; 05964800
DI:=N; DS:=5 LIT " SEGS"; SI:=SI+1; 05964900
END; DS:=11 LIT " IN USE BY "; DS:=7 CHR; DS:=LIT"/"; 05965000
SI:=SI+1; DS:=7 CHR; 05965200
DS:=2 LIT")~"; 05965400
END; 05965600
FORGETSPACE(R); 05966100
GO EXIT; 05966110
INUSE: % SEARCH THE DIRECTORY TO FIND THE NAME OF THE CONFLICTING05966200
% FILE. SINCE USERDISK REMAINS LOCKED, DISK ALLOCATION 05966210
% CANNOT CHANGE. HENCE, THE DIRECTORY NEED NOT BE LOCKED.05966220
FORGETSPACE(R); 05966400
FIXARRAY(UT,R,480); 05966600
FOR J:=DIRECTORYTOP+4 STEP 16 WHILE TRUE DO 05967000
BEGIN DISKWAIT(-R,480,J); 05967200
FOR I:=14 STEP -1 UNTIL 0 DO 05967400
BEGIN E:=UT[450+2|I]; 05967600
IF(E EQV @114)=NOT 0 THEN 05967800
BEGIN MID:="SYSTEM "; B:=FID; GO Z; END; 05967900
IF (E EQV @14) NEQ NOT 0 THEN 05968000
BEGIN B:=UT[30|I+9] AND 31; 05968200
FOR K:=1 SETP 1 UNTIL B DO 05968400
IF (C:=UT[30|I+9+K))NEQ 0 THEN 05968600
IF A GEQ C THEN IF A LSS 05968800
SA1:=(C+D:=UT[30|I+8]) THEN 05968900
BEGIN MID:=E&((LA LEQ SA1) AND 05969000
(RDT.[18:15]))[1:47:1]; 05969100
IF A+N GTR SA1 THEN N~SA1-A; 05969150
B:=UT[451+2|I]; 05969200
GO TO Z; 05969400
END; 05969600
END; 05969800
END; 05970000
END; 05970200
Z: 05970300
$ SET OMIT = NOT SHAREDISK 05970390
UNLOCKTOG(USERDISKMASK); 05970500
GO TO Y; 05970600
AZ: IF A NEQ L AND LA NEQ H THEN 05970800
BEGIN IF S=0 THEN 05971000
$ SET OMIT = NOT (SHAREDISK) 05971005
$ SET OMIT = SHAREDISK 05971095
BEGIN IF G=0 OR D=0 THEN 05971200
BEGIN USERDISKSPECIALCASE(2,E,UT,J); GO TO BZ END; 05971400
S:=IF P((G+1) DIV 2,DUP) > D THEN P(DEL,D) ELSE P; 05971600
U[J].STARTWRD:=I-S; G:=D-S; K:=G+C-1; 05971800
$ POP OMIT 05971801
MOVE(C,[UT[D]],[UT[G]]); T:=T-S; 05972000
END; 05972200
FOR G:=K STEP -1 UNTIL T DO UT[G+1]:=UT[G]; 05972400
UT[T]:=A&(A-L)[TODSIZE]; 05972600
UT[T+1]:=H&(H-LA)[TODSIZE]; 05972800
C:=C+1; 05973000
K ~ K+1; 05973100
END ELSE 05973200
IF A=L AND LA=H THEN 05973400
BEGIN C:=C-1; MOVE(K-T,[UT[T+1]],[UT[T]]); K:=K-1 END 05973600
ELSE UT[T]:=(IF A=L THEN H ELSE A)&(Q-N)[TODSIZE]; 05973800
U[J].NUMENT:=C; 05974000
IF Q=U[J].MAXSIZ THEN 05974200
BEGIN Q:=UT[H:=K-C+1].DSIZE; 05974400
FOR H:=H STEP 1 UNTIL K DO 05974600
IF P(UT[H].DSIZE,DUP) GTR Q THEN Q:=P ELSE P(DEL); 05974800
U[J].MAXSIZ:=Q; 05975000
END; 05975200
MID:=IF RDT THEN "DKTEST " ELSE "BADISK "; 05975400
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05975404
$ SET OMIT = NOT(SHAREDISK) 05975410
$ SET OMIT = SHAREDISK 05975595
DISKWAIT(R,AVS,B); 05975600
$ POP OMIT 05975601
UNLOCKTOG(USERDISKMASK); 05975610
FORGETSPACE(R); 05975620
CZ: ENTERFILE; 05975630
GO EXIT; 05975640
XDFILE: 05975700
IF (HEADER:=DIRECTORYSEARCH(TMID,NFLAG(-TFID OR M),4)) LSS 64 THEN 05975750
BEGIN 05975800
TYPE:=HEADER; 05975850
GO MSG; 05975900
END; 05975950
HA~HEADER.[FF]; 05976000
HDR~[M[HEADER~HEADER INX 0]) & 30[8:38:10]; 05976050
MID~-"BADISK "; 05976100
S~HDR[8]; % SEGMENTS PER ROW 05976150
IF A!0 THEN 05976200
BEGIN 05976250
FOR I!HDR[9] STEP -1 UNTIL 1 DO 05976300
IF (LA~HDR[I+9])!0 THEN 05976350
IF A GEQ LA AND A LSS LA+S THEN % FOUND ROW 05976400
IF A+N LEQ LA+S THEN GO FOUND ELSE GO CONFLICT; 05976450
TYPE~4; 05976500
IF FALSE THEN 05976550
BEGIN 05976600
CONFLICT: TYPE~3; 05976650
SEGS~A+N-LA-S; 05976700
END; 05976750
HEADERUNLOCK(TMID,TFID,HEADER&HA[CTF]); 05976800
GO MSG; 05976850
FOUND: 05976900
HDR[I+9]~0; 05976950
DISKWAIT(HEADER,30,HA); 05977000
IF (I~A-LA) GTR 0 THEN FORGETUSERDISK(LA,I); 05977050
IF (I~LA+S-(LA~A+N)) GTR 0 THEN FORGETUSERDISK(LA,I); 05977100
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05977124
ENTERFILE; 05977150
GO FINIS; 05977200
END; 05977250
N~S; SEGS~0; 05977300
FOR I~HDR[9] STEP -1 UNTIL 1 DO 05977350
IF (A~HDR[I+9])!0 THEN 05977400
BEGIN 05977450
HDR[I+9]~0; 05977500
DISKWAIT(HEADER,30,HA); 05977550
WORD~A; FID~DECWORD; 05977600
$ SET OMIT = NOT(DKBNODFX AND NOT DFX) 05977624
ENTERFILE; 05977650
SEGS~SEGS+N; 05977700
END; 05977750
FINIS: 05977800
FORGETSPACE(HEADER); 05977850
P(DIRECTORYSEARCH(-TMID,TFID,6),DEL); 05977900
TYPE~5; 05977950
MSG: 05978000
STREAM(TMID,TFID,SEGS,A,TYPE,BUFF); 05978050
BEGIN 05978100
SI~LOC SEGS; DI~LOC SEGS; DS~8DEC; DS~8DEC; 05978150
DI~LOC SEGS; DS~8FILL; DI~LOC A; DS~8 FILL; DI~BUFF; 05978200
DS~LIT","; SI~LOC TMID; SI~SI+1; DS~7CHR; 05978250
DS~LIT"/"; SI~SI+1; DS~7CHR; 05978300
DS~11 LIT" NOT XD-ED("; 05978350
CI~CI+TYPE; 05978400
GO T0; GO T1; GO T2; GO T3; GO T4; GO T5; 05978450
T0: DS~11 LIT"NOT ON DISK"; GO EXT; 05978500
T3: DS~8 CHR; DS~6 LIT" SEGS "; 05978550
T1: DS~6 LIT"IN USE"; GO EXT; 05978600
T2: DS~11 LIT"SYSTEM FILE"; GO EXT; 05978650
T4: SI~SI+8; DS~8 CHR; 05978700
DS~12 LIT" NOT IN FILE"; GO EXT; 05978750
T5: DI~DI-11; 05978800
DS~6 LIT" SEGS="; DS~8 CHR; DS~7 LIT" XD-ED~"; 05978850
TYPE~DI; DI~BUFF; DS~LIT" "; DI~TYPE; GO EXT; 05978900
EXT: DS~2 LIT")~"; 05978950
END STREAM; 05979000
A~1; N~SEGS; % FOR LOGGING 05979050
GO EXIT; 05979100
EXIT: 05979310
IF A!0 THEN 05979320
BEGIN 05979330
B~BUFF; 05979340
MLOGIT; 05979350
END; 05979360
IF RDT THEN M[SLEEPER INX 0] :=1 ELSE SPOUT(BUFF); 05979400
BUFF:=0; IF MSCW NEQ 1 THEN KILL([MSCW]); % CALLED AS IND. RUNNER 05979500
END; 05979600
SAVE PROCEDURE DISKIO(LOCIOD,CORE,SIZE,DISK);% 06000000
VALUE CORE,SIZE,DISK;% 06001000
REAL LOCIOD;% 06002000
INTEGER CORE,SIZE,DISK;% 06003000
BEGIN REAL IOD, OLAYIO, FIN; 06004000
OLAYIO := SIZE.[3:1]; SIZE.[3:1] := 0; 06004010
CORE:=CORE; SIZE:=SIZE; DISK:=DISK; % INTEGERIZE %645-06004100
IF DISK.[1:1] THEN 06005000
BEGIN % AUXILIARY MEMORY 06006000
$ SET OMIT = NOT(AUXMEM) 06006999
$ SET OMIT = AUXMEM 06009200
PUNT(NVLDAUXIO); 06009300
$ POP OMIT 06009400
END 06009500
ELSE BEGIN IOD := ABS(CORE) & SIZE[8:38:10] 06010000
& ((SIZE INX 29) DIV 30 +@1000)[CTF] 06011000
& CORE[24:1:1] & 3[5:46:2]; 06012000
$ SET OMIT = NOT(SHAREDISK) 06012499
STREAM(DISK,D:=CORE.[CF]); 06013000
BEGIN SI ~ LOC DISK; DS ~ 8 DEC END;% 06014000
SIZE ~ 2;% 06015000
END;% 06016000
FIN:=IF OLAYIO THEN IOD&DISK[CTC]&DISK[8:21:12] ELSE IOD; 06016100
% ACTUAL DISK ADDRESS IN FINALQUE FOR OLAY I/O-S 06016200
IOREQUEST(NABS(FIN)&@377[25:40:8],IOD,[LOCIOD]&% 06017000
(SIZE+16)[12:42:6]&OLAYIO[9:47:1]); 06018000
LOCIOD ~ 0;% 06019000
END DISKIO;% 06020000
PROCEDURE FORGETESPDISK(SEGMENT); VALUE SEGMENT; REAL SEGMENT; FORWARD; 06020500
REAL PROCEDURE GETESPDISK;% 06021000
BEGIN REAL T=NT1; 06022000
IF ESPCOUNT=0 THEN 06022100
BEGIN 06022200
STREAM(D:=T:=SPACE(2)); 06022300
DS~12 LIT " NO ESPDISK~"; 06022400
SPOUT(T); 06022500
SLEEP([ESPCOUNT],NOT 0); 06022600
END; 06022700
STREAM(T~0,A~ESPTAB:X~0); 06023000
BEGIN SI~A; 06024000
L1: IF SC=""" THEN BEGIN SI~SI+1; GO TO L1 END; 06025000
A~SI; DI~A; 06026000
L2: IF SB THEN 06027000
BEGIN TALLY~TALLY+1; SKIP SB; SKIP DB; GO TO L2 END; 06028000
T~TALLY; DS~SET; 06029000
END; 06030000
GETESPDISK~((P(DUP).[CF]-ESPTAB)|8 06031000
+P(XCH).[30:3])|6+P+ESPDISKBOTTOM; 06032000
ESPCOUNT~ESPCOUNT-1; 06033000
END; 06033100
PROCEDURE FORGETESPDISK(SEGMENT); VALUE SEGMENT; REAL SEGMENT;% 06036000
BEGIN REAL S,T; 06037000
IF SEGMENT LSS ESPDISKBOTTOM OR 06037100
SEGMENT GTR ESPDISKTOP THEN 06037200
BYBY("ESPDISK ERROR~",14); 06037300
T:=(S:=(T:=SEGMENT-ESPDISKBOTTOM) DIV 6)|6-T; 06037700
S~S.[30:15]&S[30:45:3]|ESPTAB; 06038000
STREAM(T,S); BEGIN SKIP T DB; DS~RESET END; 06038100
ESPCOUNT~ESPCOUNT+1; 06038200
END;% 06039000
$ SET OMIT = NOT(DEBUGGING) 06045999
REAL SCHEDULEIDS; % A BIT IN POSITION X MEANS THAT THERE IS A JOB IN THE06056099
% SCHEDULE(SHEET) WITH SCHEDULE-ID X. USED BY COM5, 06056100
% SELECTRUN AND CCFINISH. 06056200
$ SET OMIT = NOT(SHAREDISK) 06057000
SAVE PROCEDURE DISKWAIT(CORE,SIZE,DISK); 06061500
VALUE CORE,SIZE,DISK; 06062000
REAL CORE,SIZE,DISK; 06063000
BEGIN REAL T; 06064000
DISKIO(T,(ABS(CORE)-1)&CORE[1:1:1],SIZE,DISK); 06065000
SLEEP([T],IOMASK); 06066000
END; 06067000
PROCEDURE DISKSQUASH(BUFF); 06068000
VALUE BUFF; REAL BUFF; 06068100
BEGIN 06068200
REAL RCW=+0, B=+1, E=B+1, F=E+1, R=F+1, HI=R+1, LO=HI+1, 06068300
MSCW=-2, 06068350
CNT=LO+1, USE=CNT+1, TOG=USE+1, IOD=TOG+1; 06068400
REAL T=IOD+1, SUM=T; 06068500
REAL A1= T+1, A2=A1+1, A3=A2+1, A4=A3+1, A5=A4+1; % ARRAY VARIABLES 06068600
REAL X1=A5+1, X2=X1+1, X3=X2+1, X4=X3+1, X5=X4+1; % SCRATCH VARIABLES 06068700
REAL LOCIOD=X4, HICNT=X4, LSTCNT=X5; 06068800
BOOLEAN CONFLICT=X5+1, PASTWO=CONFLICT+1, EUNOTSQUASHED=PASSTWO+1, 06068900
FILEOK=EUNOTSQUASHED+1, SQALL=FILEOK+1; 06069000
INTEGER C=SQALL+1, D=C+1, I=D+1, S=I+1, EU=S+1, AV=EU+1, 06069100
AVSIZE=AV+1, DISKAV=AVSIZE+1, SQSIZE=DISKAV+1; 06069200
ARRAY UT=SQSIZE+1[*], MV=UT+1[*], DIR=MV+1[*], EUS=DIR+1[*]; 06069300
REAL PRTADDR=EUS+1, PRTVALUE=PRTADDR+1; 06069400
$ SET OMIT = NOT SHAREDISK 06069500
LABEL SCAN, SPOUTER,CK,OKINUSE,NOTOK,OKBOUNDS,MVEMORE,MVE, 06069900
ENDMVE,AGAIN,OK,NEXT,SQIT,STOPSQ,STOPIT,SDXIT,OUT,FIXMV; 06070000
DEFINE 06070100
$ SET OMIT = SHAREDISK 06070200
U = AVTABLE#, 06070300
$ POP OMIT 06070400
LINK = [12:10]#, 06070500
ASIZE = [3:19]#, 06070600
LOCKED = [2:1]#, 06070700
FACTOR = 10000#, 06070800
MINSIZE = 10#, 06070900
MAXMVSIZE = 900#, 06071000
KEYINMASK = [18:15]#; 06071100
COMMENT 06071200
FACTOR: THE MAXIMUM SEPARATION, IN SEGMENTS, ALLOWED 06071300
BETWEEN TWO AVAILABLE AREAS WHICH ARE TO BE 06071400
SQUASHED. IN GENERAL, FACTOR SHOULD NOT BE MADE 06071500
LARGER THAN THE CAPACITY OFA 20 ML SUBMOD,I.E., 06071600
10,000 SEGMENTS. 06071700
MINSIZE: THE MINIMUM SIZE, IN SEGMENTS, ALLOWED FOR AN 06071800
AVAILABLE AREA TO BE CONSIDERED AS A CANDIDATE 06071900
FOR SQUASHING. MINSIZE MAY BE MADE AS SMALL AS 06072000
ONE, BUT AS SQUASH TIME VARIES INVERSLY WITH 06072100
MINSIZE, SMALLER VALUES WILL INCREASE SQUASH- 06072200
ING TIME PROPORTIONALLY. MINSIZE LIMITA- 06072300
TIONS MAY BE OVERRIDEN BY THE LOOKAHEAD 06072400
FACILITY. 06072500
MAXMVSIZE: LIMITS THE NUMBER OF INDIVIDUAL AREAS IN AN 06072600
IN-USE AREA TO BE AT MOST MAXMVSIZE/3 AREAS 06072700
FOR SQUASHING TO OCCUR. 06072800
NOTE: 06072900
1) MAXMVSIZE MUST BE LESS THAN 1024, 06073000
2) MAXMVSIZE MUST BE A MULTIPLE OF 3. ; 06073100
DEFINE CELL = M[PRTADDR]#, 06073200
STOP = M[PRTADDR]#, 06073300
STOPCK = IF M[PRTADDR] THEN GO STOPSQ#, 06073400
MOVEABLE = NOT DIR[X3+4].[42:1]#, 06073500
TEMPDSK = MV[I+2].[1;1]#; 06073600
SUBROUTINE SQUASHMESS; 06073700
BEGIN 06073800
IF (X1:=P(XCH))>1 THEN X3:=IF SQSIZE!0 THEN SQSIZE 06073900
ELSE EUS[EU-1].DSIZE; 06074000
STREAM(A:=EU-1,B:=X1,C:=X3,C1:=0,C2:=0,CX:=0, 06074100
NOSQ:=EUNOTSQUASHED, X2:=X2:=SPACE(10)); 06074200
BEGIN 06074300
C1:=CI; GO TO L0; 06074400
SI:=LOC A; DS:=4 LIT" EU"; DS:=2 DEC; 06074500
A:=DI; DI:=DI-2; DS:=FILL; DS:=A; CI:=CX; 06074600
L0: C2:=CI; GO TO L2; DS:=4 LIT"NULL"; CI:=CX; 06074700
L1: DS:=7 LIT" SQUASH"; CI:=CX; 06074800
L2: CI:=CI+B; 06074900
GO TO LL0; GO TO LL0; GO TO LL2; TO TO LL2; 06075000
LL0: CX:=CI; CI:=C1; 06075100
N(NOSQ(DS:=LIT" "; CX:=CI; CI:=C2)); 06075200
CX:=CI; GO TO L1; 06075300
B(NOSQ(JUMP OUT 2 TO LL1); DS:=2 LIT"ED"; 06075400
JUMP OUT TO LL1); 06075500
DS:=3 LIT"ING"; 06075600
LL1: GO TO EXT; 06075700
LL2: DS:=LIT" "; CX:=C1; CI:=C2; 06075800
CX:=CI; GO TO L1; 06075900
SI:=B; 2(SI:=SI-8); B:=SI; 06076000
B(CX:=CI; CI:=C1); 06076100
DS:=2 LIT" ("; SI:=LOC C; 06076200
DS:=6 DEC; C:=DI; DI:=DI-6; DS:=5 FILL; DI:=C; 06076300
DS:=19 LIT" SEGMENTS AVAILABLE"; 06076400
B(JUMP OUT TO LL3); DS:=4 LIT" ON "; 06076500
CX:=CI; CI:=C1; 06076600
LL3: DS:=LIT")"; 06076700
EXT: DS:=LIT"~"; 06076800
END; 06076900
SPOUT(X2); 06077000
END PRINTING MESSAGES; 06077100
SUBROUTINE SCANMESSAGE; 06077200
BEGIN 06077300
X1:=(X5:=NEUP.[FF])-1; X2:=BUFF.[30:18]; 06077400
FIXARRAY(EUS,A5,X5); 06077500
MOVE(X5,A5-1,A5); 06077600
X5:=-1; % WILL BE GEQ ZERO AFTER FIRST PASS THRU SCAN 06077700
SCAN: 06077800
STREAM(A:=0,SIZ:=0,EU1:=-1,EU2:=-1,ERRTOG:=0:NO:=0, 06077900
B:=X5<0,EU:=@2564000000000000,CX:=0,C1:=0, 06078000
C2:=0,KTR:=X2); 06078100
BEGIN 06078200
C1:=CI; GO TO L2; 06078300
IF SC<0 THEN 06078400
A0: BEGIN TALLY:=1; NO:=TALLY; CI:=CX END; 06078500
IF SC=12 THEN GO TO A0; 06078600
DI:=LOC SIZ; 06078700
L1: IF SC GEQ 0 THEN IF SC<12 THEN 06078800
BEGIN 06078900
TALLY:=TALLY+1; 06079000
SI:=SI+1; 06079100
GO TO L1; 06079200
END; 06079300
NO:=TALLY; 06079400
SI:=SI-NO; 06079500
DS:=NO OCT; 06079600
TALLY:=0; NO:=TALLY; 06079700
CI:=CX; 06079800
L2: C2:=CI; GO TO STR; 06079900
TALLY:=1; DI:=LOC EU; 06080000
IF 2 SC=DC THEN % AN EU SPECIFIED 06080100
BEGIN 06080200
CX:=CI; GO TO L3; 06080300
IF SC GEQ 0 THEN IF SC<12 THEN 06080400
BEGIN 06080500
SI:=SI+1; DI:=LOC EU1; 06080600
IF SC GEQ 0 THEN IF SC<12 THEN 06080700
TALLY:=2 ELSE GO TO A1; 06080800
SI:=SI-1; NO:=TALLY; 06080900
DS:=NO OCT; TALLY:=0; 06081000
END ELSE GO TO A1; 06081100
END; 06081200
NO:=TALLY; CI:=A; 06081300
CI:=A; 06081400
L3: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L3 END; CI:=CX; 06081500
STR: SI:=KTR; CI:=CI+B; GO TO L5; GO TO L4; 06081600
L4: IF SC="~" THEN GO TO EXT; 06081700
CX:=CI; CI:=C1; % SIZE CHECK 06081800
NO(JUMP OUT TO L5); 06081900
CX:=CI; GO TO L3; 06082000
IF SC!"~" THEN 06082100
A1: GO TO ERR; 06082200
GO EXT; 06082300
L5: A:=CI; CI:=C2; % EU CHECK 06082400
NO(JUMP OUT TO ERR); 06082500
IF SC="-" THEN 06082600
BEGIN 06082700
SI:=SI+1; CX:=CI; GO TO L3; 06082800
CX:=CI; CI:=C1; % SIZE CHECK 06082900
NO(JUMP OUT TO L6); GO TO L7; 06083000
L6: TALLY:=EU1; EU2:=TALLY; 06083100
A:= CI; CI:=C2; % EU CHECK 06083200
NO(JUMP OUT TO ERR); 06083300
END; 06083400
L7: A:=TALLY; % ZERO OUT A 06083500
IF SC="~" THEN GO TO EXT; 06083600
IF SC="," THEN 06083700
BEGIN SI:=SI+1; A:=SI; GO EXT END; 06083800
ERR: TALLY:=1; ERRTOG:=TALLY; 06083900
EXT: 06084000
END; 06084100
IF P THEN % ERROR IN INPUT MESSAGE 06084200
BEGIN 06084300
SPOUTERR: 06084400
SPOUT(P(BUFF.[15:15]-1,DUP)&M[P-1][9:9:9]); 06084500
FORGETSPACE(A5); 06084600
P(XIT); 06084700
END; 06084800
IF (X3:=P) GEQ 0 THEN % AN EU RANGE SPECIFIED. 06084900
BEGIN 06085000
IF (X4:=P)>X1 OR X3<X1 THEN GO SPOUTERR; 06085100
FOR I:=X3 STEP 1 UNTIL X4 DO EUS[I]:=1; 06085200
P(DEL); GO CK; 06085300
END; 06085400
X5:=P(XCH); % SIZE OF SQUASH 06085500
IF (X4:=P) GEQ 0 THEN IF X4>X1 THEN GO SPOUTERR ELSE 06085600
EUS[X4]:=1&X5[TODSIZE] ELSE IF X5=0 THEN SQALL:=1 06085700
ELSE SQSIZE:=X5; 06085800
CK: IF (XS:=P)!0 THEN GO SCAN; % NOT FINISHED YET 06085900
END SCANNING INPUT MESSAGE; 06086000
SUBROUTINE FIXANDWRITEHEADER; 06086100
BEGIN 06086200
M[A4+9+X2.[28:5]]:=C; 06086300
DISKWAIT(A4,30,X2.[CF]); 06086400
END WRITING NEW HEADER; 06086500
SUBROUTINE BOUNDARYCK; 06086600
BEGIN 06086700
LSTCNT:=0; M[X2-1]:=-1; 06086800
MVEMORE: 06086900
X3:=HICNT:=0; STOPCK; 06087000
FOR I:=CNT SETP -3 UNTIL 0 DO 06087100
IF P(MV[I],DUP).DEND>X3 AND P(XCH)>0 THEN 06087200
BEGIN X3:=MV[I].DEND; HICNT:=I END; 06087300
IF X3=0 THEN % RE-ORDERING OF MV ARRAY COMPLETE 06087400
BEGIN 06087500
MV[LSTCNT+2].LINK:=@1777; 06087600
GO OKBOUNDS; 06087700
END; 06087800
IF M[A2-1]<0 THEN M[A2-1]:=HICNT ELSE MV[LSTCNT+2].LINK:=HICNT; 06087900
MV[LSTCNT:=HICNT]:=NABS(*P(DUP)); 06088000
MV[HICNT+1].[2:26]:=HI; 06088100
HI:=HI-(X3:=MV[HICNT].DSIZE); 06088200
IF X3 LEQ UT[AV+1].ASIZE THEN 06088300
OK: BEGIN 06088400
MV[HICNT+2]:=0; 06088500
GO MVEMORE; 06088600
END ELSE 06088700
BEGIN % LOOKING FOR TEMPORARY STORAGE 06088800
FOR I:=S-2 STEP -1 UNTIL D DO 06088900
IF X3 LEQ UT[I].ASIZE THEN 06089000
IF NOT UT[I].LOCKED THEN % OK FOR TEMP STORAGE 06089100
BEGIN 06089200
MV[HICNT+2]:=UT[I].DEND&I[2:38:10]; 06089300
GO MVEMORE; 06089400
END; 06089500
END; 06089600
IF PASSTWO THEN % NON-PROTECTED FILE TRANSFER 06089700
BEGIN 06089800
DISKWAIT(-A4,30,MV[HICNT+2].[CF]); 06089900
STREAM(A:=[M[A4+MV[HICNT+2].[FF]]],X2:=X2:=SPACE(6)); 06090000
BEGIN 06090100
DS:=27 LIT" #FILE INTEGRITY CONFLICT: "; SI:=A; 06090200
SI:=SI+1; DS:=7 CHR; DS:=LIT"/"; SI:=SI+1; 06090300
DS:=7 CHR; DS:=LIT"~"; 06090400
END; 06090500
SPOUT(X2); CELL.KEYINMASK:=7; 06090600
SLEEP((PRTADR INX M),@77777); STOPCK; 06090700
IF CELL=2 THEN BEGIN CELL:=0&1[CTF]; GO TO OK END; 06090800
END ELSE CONFLICT:=TRUE; 06090900
TOG:=0; 06091000
OKBOUNDS: 06091100
END BOUNDARY AND CONFLICT CHECKING; 06091200
BOOLEAN SUBROUTINE INUSEOK; 06091300
BEGIN 06091400
UT[AV+1].[1:1]:= NOT PASSTWO; TOG:=1; CNT:=0; 06091500
FOR X1:=DIRECTORYTOP+4 STEP 16 WHILE TRUE DO 06091600
BEGIN STOPCK; 06091700
DISKWAIT(-A1,480,X1); 06091800
FOR I:=14 STEP -1 UNTIL 0 DO 06091900
BEGIN STOPCK; 06092000
IF((E:=DIR[450+P(I,DUP,+)]) EQV @114)=NOT 0 THEN 06092100
GO TO NOTOK; 06092200
IF (E EQV @14)! NOT 0 THEN 06092300
BEGIN FILEOK:=FALSE; % INITIATE STATUS CHECKING 06092400
B:=DIR[(X3:=30|I)+9].[43:5]; 06092500
FOR X2:=1 STEP 1 UNTIL B DO 06092600
IF (C:=DIR[X3+9+X2])!0 THEN 06092700
IF P(C,DUP)<HI AND P(XCH)>LO THEN 06092800
IF FILEOK THEN GO FIXMV ELSE % CHECK STATUS 06092900
IF NOT SYSTEMFILE(E,DIR[450+P(I,DUP,+)+1]) AND 06093000
DIR[X3+4].[12:4]=0 THEN % NOT SYSTEM FILE 06093100
IF (P(DIR[X3+4],DUP).[1:3] OR P(XCH).[16:20] OR 06093200
DIR[X3+9].[1:28])=0 THEN % FILE NOT IN USE 06093300
IF MOVEABLE THEN % NOT PERMANENT 06093400
BEGIN 06093500
FILEOK:=TRUE; % ELIMINATE STATUS CHECKING 06093600
FIXMV: USE:=USE-(MV[CNT]:=C&DIR[X3+8][TODSIZE]) 06093700
.DSIZE; 06093800
MV[CNT+1]:=(X1+I)&X2[CTF]; % HEADER INFO 06093900
IF PASSTWO THEN % SAVE LOC OF FIDS 06094000
MV[CNT+2]:=(X1+15)&(I|2)[CTF]; 06094100
IF USE=0 THEN % FOUND ALL USERS OF IN-USE AREA 06094200
BEGIN 06094300
BOUNDARYCK; 06094400
GO OKINUSE; 06094500
END; 06094600
IF USE<0 THEN GO TO NOTOK; % DIERCTORY ERROR 06094700
IF (CNT:=CNT+3) MOD 150 = 0 THEN 06094800
BEGIN 06094900
IF CNT=MAXMVSIZE THEN GO TO NOTOK; 06095000
FIXARRAY(MV,X4,(CNT+150)); 06095100
MOVE(CNT,A2,X4); 06095200
FORGETSPACE(A2); 06095300
A2:=X4; 06095400
END; 06095500
END ELSE GO TO NEXT ELSE GO TO NEXT; 06095600
END; 06095700
NEXT: END; 06095800
END; 06095900
NOTOK: 06096000
TOG:=0; 06096100
OKINUSE: 06096200
INUSEOK:=TOG; 06096300
END SEARCHING IN USE AREAS; 06096400
SUBROUTINE MOVEANDFIX; 06096500
BEGIN 06096600
I:=M[X2-1]; STOPCK; 06096700
WHILE I<@1777 DO 06096800
BEGIN 06096900
DISKWAIT(-A4,30,(X2:=MV[I+1]).[CF]); % READ IN HEADER 06097000
MVE: X1:=-30; F:=P(MV[I],DUP).DEND+(B:=P(XCH).ASIZE); 06097100
IF P(MV[I+2].DEND=0,DUP) THEN C:=MV[I+1].[2:26] ELSE 06097200
MV[I].DEND:=(C:=MV[I+2].DEND)-B; 06097300
WHILE (X1:=X1+30)<B DO 06097400
BEGIN 06097500
E:=IF P((B-X1),DUP)<30 THEN P ELSE P(DEL,30); 06098300
DISKIO(T,1-A3,E|30,F:=F-E); 06098400
IOD:=IOD&(E|30)[8:38:10]&E[27:42:6]; 06098500
LOCIOD:=0; SLEEP([T],IOMASK); 06098600
STREAM(A:=C:=C-E,B:=A3-1); 06098700
BEGIN SI:=LOC A; DS:= 8 DEC END; 06098800
IOREQUEST(NABS(IOD)&@357[25:40:8],IOD, 06098900
[LOCIOD]&18[12:42:6]); 06099000
SLEEP([LOCIOD],IOMASK); 06099100
IF LOCIOD.[28:1] THEN % WRITE LOCKOUT OCCURED 06099200
BEGIN 06099300
UT[IF P THEN AV+1 ELSE MV[I+2].[2:10]].LOCKED:=1; 06099400
UT[AV+1].DEND:=MV[I+1].[2;26]; GO ENDMVE; 06099500
END; 06099600
END; 06099700
FIXANDWRITEHEADER; 06099800
IF NOT P THEN % TEMPORARY DISK STORAGE WAS USED. 06099900
BEGIN 06100000
MV[I-2].DEND:=0; 06100100
TEMPDISK:=1; 06100200
GO TO MVE; 06100300
END; 06100400
I:=MV[I+2].LINK; 06100500
END; 06100600
% WILL NOW RECONFIGURE THE AVAILABLE TABLE 06100700
UT[AV]:=HI&(UT[AV].ASIZE+UT[AV+I].ASIZE)[2:28:20]; 06100800
MOVE(S-AV,P([UT[AV+2]],DUP),NOT 0 INX P(XCH)); 06100900
C:=(S:=S-1)-1; FOR I:=C STEP -1 UNTIL D DO 06101000
IF P(UT[I].ASIZE,DUP)>USE THEN USE:=P ELSE P(DEL); 06101100
U[EU]:=P(DUP,LOD,DUP)&USE[1:28:20]&(P(XCH).NUMENT-1)[TONUMENT]; 06101200
EUNOTSQUASHED:=FALSE; 06101300
IF NOT SQALL THEN 06101400
BEGIN 06101500
IF P(SQSIZE,DUP)!0 AND P(XCH) LEQ USE THEN CELL:=1 06101600
ELSE IF P(EUS[EU-1],DSIZE,DUP)!0 AND P(XCH) LEQ USE 06101700
THEN ELSE GO TO ENDMVE; 06101800
P(DEL); GO STOPSQ; 06101900
END; 06102000
ENDMVE: 06102100
END FIXING AND MOVING; 06102200
$ SET OMIT = NOT SHAREDISK 06102220
P(0,0,0,0,0,0,0,0,0,0); 06102500
P(0,0,0,0,0,0,0,0,0,0); 06102600
P(0,0,0,0,0,0,0,0,0,0); 06102700
P(0,0,0,0,0,0,0,0,0); 06102800
P(.DISKSQUASH,DUP,M[(P)]); % PRTADDR,PRTVALUE 06102900
$ SET OMIT = NOT SHAREDISK 06103000
SCANMESSAGE; 06103300
$ SET OMIT = SHAREDISK 06103400
LOCKDIRECTORY; 06103500
$ POP OMIT 06103600
SLEEP([TOGLE],USERDISKMASK); LOCKTOG(USERDISKMASK); 06103700
HALT; % STOP NORMAL STATE PROCESSING WHILE SQUASHING 06103800
A4:=SPACE(30); 06103900
$ SET OMIT = NOT SHAREDISK 06104000
FIXARRAY(DIR,A1,480); FIXARRAY(MV,A2,150); 06107200
A3:=SPACE(900); 06107300
IOD:=@140000100000000&(A3-1)[CTC]; 06107400
IF NOT SQALL THEN FOR EU:=1 STEP 1 UNTIL NEUP.[FF] DO 06107900
IF (CELL:=(P(SQSIZE,DUP)!0 AND P(XCH) LEQ U[EU].[1:20])) 06108000
THEN BEGIN P(2); SQUASHMESS; GO STOPIT END; 06108100
FOR EU:=1 STEP 1 UNTIL NEUP.[FF] DO % 06108200
IF NOT (E:=U[EU]).EUNP THEN % NOT A DUMMY EU 06108300
IF EUS[EU-1] OR SQALL OR SQSIZE!0 THEN % SQUASH THIS EU 06108400
BEGIN 06108500
EUNOTSQUASHED:=TRUE; 06108600
IF NOT SQALL THEN % CHECK IF SQUASH IS NECESSARY 06108700
IF (P(EUS[EU-1].DSIZE,DUP) LEQ E.[1:20] AND P(XCH)!0) 06108800
THEN BEGIN P(3); SQUASHMESS; GO STOPIT END; 06108900
CELL:=0&1[CTF]; 06109000
P(0); SQUASHMESS; 06109100
D:=(I:=E.STARTWRD) MOD 30; 06109200
AVSIZE:=30-(S:=(E AND NUMENTM)+D) MOD 30+S; 06109300
FIXARRAY(UT,R,AVSIZE); 06109400
DISKAV:=I DIV 30+USERDISKBOTTOM; 06109500
$ SET OMIT = NOT SHAREDISK 06109600
DISKWAIT(-R,AVSIZE,DISKAV); 06110300
AGAIN: SUM:=USE:=0; 06110400
FOR I:=S-3 STEP -1 UNTIL D DO 06110500
BEGIN STOPCK; 06110600
IF (UT[I+1]<0)=PASSTWO THEN % NOT CHECKED THIS PASS 06110700
IF ((X1:=UT[I].ASIZE)+(X2:=UT[I+1].ASIZE)) GEQ SUM 06110800
THEN IF (X3:=(((X4:=UT[I+1].DEND)-1)-UT[I+1].ASIZE)- 06110900
X5:=(UT[I].DEND-1)) LEQ FACTOR THEN IF MINSIZE LEQ X2 06111000
THEN IF MINSIZE LEQ X1 THEN 06111100
BEGIN 06111200
SQIT: USE:=X3; AV:=I; 06111300
SUM:=X1-X2; % SUM OF CURRENT AVAILABLE AREAS 06111400
HI:=X4; LO:=X5; 06111500
END ELSE IF I!0 THEN % LOOK AHEAD TO NEXT AREA 06111600
IF ((MINSIZE LEQ UT[I-1].ASIZE) AND (((X5-X1)- 06111700
UT[I-1].DEND-1) LEQ FACTOR)) THEN GO SQIT; 06111800
END; 06111900
IF USE!0 THEN % FOUND A POSSIBLE SQUASH SITUATION 06112000
BEGIN 06112100
IF INUSEOK THEN MOVEANDFIX; 06112200
GO AGAIN; 06112300
END ELSE % TIME TO WRAP IT UP FOR THIS EU UNLESS.... 06112400
IF CONFLICT THEN IF NOT PASSTWO THEN % ..CONFLICTS EXIST 06112500
BEGIN 06112600
PASSTWO:=TRUE; 06112700
GO AGAIN; 06112800
END ELSE 06112900
BEGIN % CLEAN-UP PASS AFTER CONFLICTS RESOLVED. 06113000
PASSTWO:=CONFLICTS:=0; 06113100
GO AGAIN; 06113200
END; 06113300
STOPSQ: FOR I:=D STEP 1 UNTIL S DO UT[I]:=ABS(P(DUP.LOD)&0[2:2:1]); 06113400
IF NOT EUNOTSQUASHED THEN 06113500
$ SET OMIT = NOT SHAREDISK 06113600
DISKWAIT( R,AVSIZ,DISKAV); 06114300
FORGETSPACE(R); 06114400
P(1); SQUASHMESS; 06114500
STOPIT: IF STOP THEN GO OUT; % STOPCK GOT US HERE 06114600
END EU LOOP; 06114700
OUT: 06114800
FORGETSPACE(A1); FORGETSPACE(A2); FORGETSPACE(A3); 06114900
$ SET OMIT = NOT SHAREDISK 06115000
SDXIT: 06115500
FORGETSPACE(A4); FORGETSPACE(A5); 06115600
CELL:=PRTVALUE; 06115700
STREAM(A:=BUFF.[15:15]-1); DS:=13 LIT" END SQUASH.~"; 06115800
SPOUT(BUFF.[15:15]-1); 06115900
$ SET OMIT = SHAREDISK 06115990
UNLOCKDIRECTORY; 06116000
$ POP OMIT 06116010
UNLOCKTOG(USERDISKMASK); 06116100
NOPROCESSTOG:=NOPROCESSTOG-1; 06116200
KILL([MSCW]); 06116300
END SQUASHING; 06116400
PROCEDURE CHANGEABORT(X); VALUE X; REAL X; FORWARD;% 06179000
REAL LOOKQ; 06179200
PROCEDURE SIGNOFF(VECTOR,FILEBLOCK,PKT); 06180000
VALUE VECTOR,FILEBLOCK,PKT; 06181000
ARRAY VECTOR[*],FILEBLOCK[*];% 06182000
REAL PKT; 06182100
BEGIN ARRAY NAME LOG; 06183000
INTEGER N,L,I,J,TIMEX;% 06184000
INTEGER MIX; 06184100
$ SET OMIT = NOT STATISTICS 06184199
REAL TIMEAX,T,A,Q,ESED; 06185000
$ SET OMIT = NOT(PACKETS) 06185099
REAL UNITNO; 06185100
INTEGER ARRAY PM[*]; 06185105
$ POP OMIT 06185110
$ SET OMIT = NOT(WORKSET AND WORKSETMONITOR) 06185111
REAL DD; 06185112
$ POP OMIT % WORKSET AND WORKSETMONITOR 06185113
SUBROUTINE TIMEIT;% 06186000
BEGIN CHANGEABORT(0);% 06187000
WHILE (NT2:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO 06188000
MIDNIGHT; 06188100
LOG[TIMEAX+2] ~ NT2;% 06189000
$ SET OMIT = NOT(STATISTICS) 06189099
STOPLOG(P1MIX,0); 06190000
MIX~P1MIX; P1MIX~0; 06190100
IDLETIME;% 06191000
OLDIDLETIME ~ (LOG[TIMEX] ~ VECTOR[3]+% 06192000
PROCTIME[MIX])+OLDIDLETIME; 06193000
PROCTIME[MIX] ~ -VECTOR[3];% %127-06193500
LOG[TIMEX+1]~VECTOR[4]+IOTIME[MIX]; 06194000
$ SET OMIT = NOT WORKSET 06194890
LOG[TIMEX+2] ~ OLAYTIME[MIX]; %710-06194900
$ SET OMIT = WORKSET%710-06194990
$ SET OMIT = NOT(WORKSET AND WORKSETMONITOR) 06195090
IF WKSETMONITOR AND (DD=0) THEN 06195095
BEGIN 06195100
STREAM(N1 := VECTOR[0], N2 := VECTOR[1], 06195105
T1 := ((LOG[TIMEX]+0.5)/60 DIV 1), 06195110
T2 := ((LOG[TIMEX+1]+0.5)/60 DIV 1), 06195115
T4 ~ (OLAYTIME[MIX]+59) DIV 60, % OLAY I/O TIME IN SECS %710-06195118
T3:=(((LOG[TIMEAX+2]-VECTOR[5].[24:24])+0.5)/60 DIV 1), 06195120
DV:=0, DD := DD := SPACE(10)); 06195125
BEGIN 06195130
SI:=LOC N; DS:=LIT" "; 06195135
2(SI:=SI+1; DS:=7CHR; DS:=LIT" "); 06195140
DS:=4LIT"CPU="; 06195145
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195150
DS:=5LIT" I/O="; 06195155
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195160
DS~ 6LIT" OLAY="; %710-06195161
DS~ 6DEC; DV~ DI; DI~ DI-6; DS~ 5FILL; DI~ DV; %710-06195162
DS:=6LIT" ELAP="; 06195165
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195170
DS:=LIT"~"; 06195175
END STREAM STATEMENT; 06195180
SPOUT(DD); 06195185
END; 06195190
$ POP OMIT % WORKSET AND WORKSETMONITOR 06195195
STREAM(A~VECTOR[5].[1:23]:B~0);% 06196000
BEGIN SI ~ LOC A; DI ~ LOC A; DS ~ 8 DEC END;% 06197000
LOG[TIMEAX] ~ P(XCH);% 06198000
LOG[TIMEAX+1] ~ VECTOR[5].[24:24];% 06199000
$ SET OMIT = NOT(STATISTICS) 06199099
NT4 ~ VECTOR[2].[8:10];% 06200000
LOG[TIMEAX+3] ~ IF VECTOR[1] < 0 THEN (NT4= 99) 06201000
+2 ELSE NT4 = 3;% 06202000
LOG[TIMEAX+3].[1:30]~ DATE.[18:30]; 06202100
LOG[TIMEAX+4]:=USERCODE[MIX]; 06203000
$ SET OMIT = NOT(DCLOG AND DATACOM) 06203099
IF TABCNT[MIX]!0 THEN 06203600
BEGIN T:=CLOCK+900; 06203650
COMPLEXSLEEP(TABACNT[MIX]=0 OR CLOCK>T); 06203700
END; 06203750
$ SET OMIT = NOT (DATACOM AND NOT DCLOG) 06203790
PRTROW[MIX].[PSF]:=0; 06204000
$ SET OMIT = NOT(PACKETS) 06205009
UNITNO:=PSEUDOMIX[MIX]; 06205010
PSEUDOMIX[MIX]:=0; 06205020
PM[0]:=LOG[TIMEX ]/60; 06205030
PM[1]:=LOG[TIMEX+1]/60; 06205040
$ SET OMIT = NOT(WORKSET) OR OMIT %759-06205049
PM[2]:=OLAYTIME[MIX]/60; %759-06205050
$ POP OMIT 06205051
$ POP OMIT %759-06205052
USERCODE[MIX] := 0; 06205100
STREAM(S~[NFO[(MIX-1)|NDX]]);% 06205200
BEGIN DS~8 LIT "0"; DI~S; DS~2 WDS; END;% 06205300
$ SET OMIT = NOT STATISTICS 06205540
JARROW[MIX]:=PRTROW[MIX]:=0; 06206000
END TIMET; 06206100
$ SET OMIT = NOT(PACKETS) 06206109
SUBROUTINE MESSAGE; 06206110
IF UNITNO!0 OR (VECTOR.[24:9]!0) THEN 06206120
BEGIN 06206130
STREAM(A:=[VECTOR[0]],MIX,B:=[PM[0]],T:=T:=SPACE(10)); 06206140
BEGIN DS:=5LIT" FOR";SI:=A;SI:=SI+1;DS:=7CHR; 06206150
DS:=LIT"/";SI:=SI+1;DS:=7CHR;SI:=LOC MIX; 06206160
DS:=LIT"=";DS:=2DEC; 06206170
A:=DI;DI:=DI-2;DS:=FILL;DI:=A; SI:=B; 06206175
DS:=10 LIT ": PROCESS="; DS:=5 DEC; %759-06206180
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; 06206190
DS:=10 LIT " SECS, IO="; DS:=5 DEC; %759-06206200
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; 06206205
$ SET OMIT = NOT(WORKSET) OR OMIT %759-06206209
DS:=12 LIT " SECS, OLAY="; DS:=5 DEC; %759-06206210
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; %759-06206215
$ POP OMIT %759-06206216
DS:=LIT"~"; 06206220
END; 06206230
SPOUTER(T,IF VECTOR.[24:9] NEQ 0 THEN 06206240
VECTOR.[24:9] ELSE UNITNO,64); 06206250
END; 06206260
$ POP OMIT 06206261
A ~ VECTOR[6].[33:15];% 06207000
ESED:=VECTOR[2].[2:1]; 06207100
T:=Q:=((L:=VECTOR[6].[18:15])+(IF ESED THEN N~0 ELSE 06208000
N:=FILEBLOCK.[8:10])+60) DIV 25|27; 06209000
LOG:=[M[TYPEDSPACE(T,LOGAREAV)]];% %167-06210000
M[LOG INX NOT 1].[9:6] ~ 0;% 06211000
$ SET OMIT = NOT(PACKETS) 06211099
PM:=[M[SPACE(5)]]&5[8:38:10]; 06211100
M[PM INX NOT 1].[9:6]:=0; 06211200
$ POP OMIT 06211201
J ~ A;% 06212000
DO BEGIN I ~ I+27;% 06213000
DISKIO( T ,-( LOG INX I),26,J);% 06214000
SLEEP([T],IOMASK);% 06215000
J ~ LOG[I+1];% 06216000
END UNTIL J=0 OR I+53>Q;% 06217000
IF VECTOR[2].[8:10]=0 THEN L ~ LOG[29]; 06217100
IF(I:=(L-5) MOD 25+I+7) LSS Q-3 THEN 06218000
IF I MOD 27 = 0 THEN% 06219000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06220000
I ~ I+2 END;% 06221000
$ SET OMIT = NOT(STATISTICS) 06221099
LOG[I]:= IF VECTOR[0] LSS 0 06222000
THEN IF VECTOR[0]=(-"COBOL ") THEN 2 06222100
ELSE IF VECTOR[0]=(-"FORTRAN") THEN 6 06222200
ELSE IF VECTOR[0]=(-"BASIC ") THEN 7 06222300
ELSE IF VECTOR[0]=(-"XALGOL ") THEN 9 06222400
ELSE IF VECTOR[0]=(="TSPOL ") THEN 10 06222500
ELSE IF VECTOR[0]=(-"COBOL68") THEN 11 06222550
ELSE 1 ELSE 0; 06222600
LOG[I+1] ~ N DIV 5;% 06223000
IF(I:=(TIMEX:=I+2)+3) LSS Q-1 THEN 06224000
IF I MOD 27 = 0 THEN% 06225000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06226000
I ~ I+2;% 06227000
END;% 06228000
I ~ (TIMEAX ~ 1)+5;% 06229000
IF NOT ESED THEN%IF JOB ES-ED THEN NO FPB ENTRIES 06229100
FOR J ~ 5 STEP 5 UNTIL N DO% 06230000
IF FILEBLOCK[J-1]=0 THEN LOG[TIMEX -1]~*P(DUP)-1 ELSE 06230100
BEGIN IF I MOD 27 = 0 THEN% 06231000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06232000
I ~ I+2 END;% 06233000
IF I+4 LEQ Q THEN 06233100
STREAM(A~[FILEBLOCK[J-5]],B~[LOG[I]]);% 06234000
BEGN SI ~ A; DS ~ 5 WDS END;% 06235000
IF I+4 LEQ Q THEN 06235100
IF LOG[I+4] < 0 THEN 06236000
BEGIN LOG[I+4] ~ *P(DUP)+CLOCK+P(RTR);% 06237000
LOG[I+3].[24:12]~P(DUP,DUP).[24:12]+TINU06238000
[NT1~P(XCH).[36:6]-1].[18:12];% 06239000
TINU[NT1].[18:12] ~ 0;% 06240000
END;% 06241000
IF LOG[I+2].[18:30]=0 THEN 06241100
LOG[I+2].[18:30]:=DATE.[18:30];%ENTER CURR DATE 06241200
I ~ I+5% 06242000
END;% 06243000
N ~ LOG[TIMEX -1]|5; 06243100
FORGETSPACE(FILEBLOCK);% 06244000
J ~ 0;% 06245000
IF VECTOR[2].[8:10] = 1 THEN% 06246000
BEGIN DO J ~ J+27 UNTIL LOG[J+1] = 0;% 06247000
WHILE J+27 LSS I AND I LSS Q DO% 06248000
BEGIN LOG[J+1] ~ GETESPDISK;% 06249000
J ~ J+27;% 06250000
END;% 06251000
I ~ 27;% 06252000
TIMEIT;% 06253000
LOG[29]~5|LOG[40]+20; 06253500
DO BEGIN DISKIO(T,LOG INX I,26,A);% 06254000
A ~ LOG[I+1];% 06255000
I ~ I+27;% 06256000
SLEEP([T],IOMASK);% 06257000
END UNTIL A = 0;% 06258000
END% 06259000
ELSE BEGIN 06260000
DO BEGIN J~J+27; 06260100
FORGETESPDISK(A);% 06261000
A ~ LOG[J+1];% 06262000
END UNTIL A = 0;% 06263000
IF LOGFREE=0 THEN TIMEIT ELSE 06263100
BEGIN A~J+29; 06263200
LOG[29]~3; 06265000
I ~ I+6;% 06266000
WHILE (J ~ J+27) < I DO% 06267000
BEGIN A ~ A+25;% 06268000
STREAM(X~[LOG[J]],Y~[LOG[A]]);% 06269000
BEGIN SI ~ X; DS ~ 25 WDS END;% 06270000
IF TIMEX } A THEN TIMEX ~ TIMEX-2; 06271000
IF TIMEAX } A THEN TIMEAX ~ TIMEAX-2; 06272000
END;% 06273000
N ~ (N+L) DIV 5+3;% 06278000
L ~ 28;% 06279000
IF TIMEX+2 LSS Q AND TIMEAX+4 LSS Q THEN 06279100
TIMEIT; LOGSPACE(L+1 INX LOG,(N-1)|5); 06280000
END;% 06327000
END;% 06328000
$ SET OMIT = NOT(PACKETS) 06328099
MESSAGE; FORGETSPACE(PM); 06328100
IF UNITNO!0 THEN 06328200
DRAINO(UNITNO,(VECTOR[2].[8:10]!1) OR (PKT!0), 06328300
((VECTOR[1]<0) OR (VECTOR[2].[8:10]=3)) 06328400
%VECTOR[6][1:1:1]); 06328500
$ POP OMIT 06328501
FORGETSPACE(LOG);% 06329000
END SIGNOFF;% 06330000
PROCEDURE USERDISKSPECIALCASE(Q,R,UT,J) ; 06350000
VALUE Q,J; REAL R,J; INTEGER Q; ARRAY UT[*] ; 06350300
BEGIN 06350600
REAL BUFF=Q,N=J,Z=UT,E=R ; 06351000
$ SET OMIT = NOT(SHAREDISK ) 06351050
$ SET OMIT = SHAREDISK 06351100
REAL NEU,NT; ARRAY UA[*]; 06351104
DEFINE U=AVTABLE #, AVS=B #, NEU1=J-1 #, NEU2=NT-1 #; 06351105
$ POP OMIT 06351106
INTEGER NT1,NT3,NT4,B ; 06351250
LABEL L1,L2,L3,UP,PU,BD,WHY,M1,T10 ; 06351500
SWITCH SW,~L1,L2,L3 ; 06351800
IF Q!0 THEN GO SW[Q-1] ; 06352000
$ SET OMIT = NOT(SHAREDISK ) 06352490
L1: BUFF:=R; Z:=0; UNLOCKTOG(USERDISKMASK); 06353500
IF N LEQ RESERVEDISKSIZE THEN% CALL OUT RESERVES 06353510
IF (Z:=DIRECTORYSEARCH("RESERVE","DISK ",6)) NEQ 0 THEN 06353530
BEGIN FORGETSPACE(Z); 06353540
IF N>0 THEN 06353541
$ SET OMIT = PACKETS 06353542
BEGIN STREAM(Z:=Z:=SPACE(3)); 06353545
DS!23 LIT "**RESERVE/DISK REMOVED~"; 06353550
SPOUTER(Z,25,(NOT LIBMSG) AND 1); %523-06353551
END; 06353552
FORGETSPACE(BUFF); P(XIT); %528-06353555
END OF RESERVE CALL UP; 06353570
IF AUTOUNLD THEN 06353580
BEGIN P(P1MIX); AUTOUNLD:=P1MIX:=0; 06353590
STREAM(A:=DATE,Z:=Z:=SPACE(10)+2); 06353600
BEGIN DS:=23 LIT"CC UNLOAD EXPIRED TO XP"; 06353610
SI:=LOC A; SI:=SI+3; DS:=5 CHR; 06353620
DS:=9 LIT " =/=;END."; 06353630
END; 06353640
INDEPENDENTRUNNER(P(.CONTROLCARD),Z&31[3:43:5],192); 06353650
P1MIX:=P; 06353660
IF N GEQ 0 THEN 06353670
BEGIN STREAM(Z:=Z:=SPACE(10)); 06353680
DS:=18 LIT"18 AUTOUNLD RESET~"; 06353690
SPOUT(Z); 06353700
END END AUTOMATIC UNLOADING; 06353710
IF NOT N.[2:1] THEN 06353720
BEGIN IF P1MIX!0 THEN 06354000
BEGIN 06354100
NT1 ~ NOTERMSET(P1MIX); % NOTE: NT1 IS LOCAL %537-06354200
WHY: STREAM(J:=JARROW[P1MIX],P1MIX,N,BUFF); 06355000
BEGIN DS~14 LIT "#NO USER DISK:"; 06356000
SI~J; SI~SI+1; DS~7 CHR; 06357000
DS~LIT "/"; SI~SI+1; DS~7 CHR; 06358000
SI~LOC P1MIX; DS~LIT "="; DS~2 DEC; 06359000
J:=DI; DI:=DI-2; DS:=FILL; DI:=J; DS:=LIT"-"; 06359500
SI:=LOC N; DS:=8 DEC; DS:=7 LIT" SEGS.~"; 06360000
DI:=DI-15; DS:=7 FILL; 06360500
END; 06360505
SPOUT(BUFF); 06360510
IF AUTODS AND NOTERMSET(P1MIX) THEN %747-06360515
TERMINATE(P1MIX&61[CTF]) ELSE %747-06360516
BEGIN %747-06360517
REPLY[P1MIX]:=-VWY&VOK[36:42:6]; 06360520
COMPLEXSLEEP((REPLY[P1MIX] GTR 0) OR 06360530
(TERMSET(P1MIX) AND NT1)); %537-06360540
END; %747-06360542
IF NT1 THEN %537-06360545
IF TERMSET(P1MIX) THEN 06360550
BEGIN PRTROW[P1MIX].[7:1]~1; 06360560
GO TO INITIATE; 06360570
END; 06360580
IF NOT WHYSLEEP(VWY&VOK[36:42:6]) THEN 06360590
BEGIN BUFF~SPACE(10); 06360600
GO TO WHY; 06360610
END; 06360620
END ELSE 06361000
BEGIN 06361010
STREAM(N,BUFF); 06361100
BEGIN DS:=20 LIT"#NO USER DISK:MCP - "); 06361200
SI:=LOC N; DS:=8 DEC; 06361300
DS:=6 LIT" SEGS~"; 06361400
DI:=DI-14; DS:=7 FILL; 06361500
END; 06361600
SPOUT(BUFF); 06361610
NT1:=0; DO SLEEP([CLOCK], NOT CLOCK) 06361700
UNTIL (NT1~NT1+1)=30); 06361705
END; 06361710
END ELSE FORGETSPACE(BUFF); 06365110
P(XIT) ; 06380070
L2: U[J]:=E; E:=NEU:=(NT:=NEUP.NEUF)+2+(NT+1)DIV 2; P(NT); J:=1; 06380100
$ SET OMIT = SHAREDISK 06380120
NT1:=NT+NT+NT; FORGETSPACE(UT); FIXARRAY(UA,NT2,NT1); E:=0; 06380140
$ POP OMIT 06380141
UP: IF (NT4:=E MOD 30) LSS (NT3:=(NT1:=U[J].STARTWRD) MOD 30) 06380150
THEN NT4:=NT3 ; 06380200
IF (NT2:=(Q:=U[J] AND NUMENTM)+NT4) GTR 1023 06380250
OR ((Q+E+1) DIV 30+1-E DIV 30) GTR 34 THEN 06380300
BD: BYBY("ODISK IS TOO CHECKERED...PLEASE COMPACT IT~",43) ; 06380350
DISKWAIT(-((UA[NEU1]:=(UA[NEU2+J]:=SPACE(NT2))+NT4)-NT3),Q+NT3, 06380400
USERDISKBOTTOM~NT1 DIV 30) ; 06380450
$ SET OMIT = NOT(SHAREDISK ) 06380490
$ SET OMIT = SHAREDISK 06380520
IF J=1 THEN B:=UA.[CF]+NT+NT-1 ; 06380525
$ POP OMIT 06380526
M[B+J]:=U[J]&E[TOSTARTWRD] ; 06380550
IF (NT1:=Q DIV 4) LSS AVDIFFMIN THEN NT1:=AVDIFFMIN ; 06380600
IF (E:=E+Q+NT1) GTR AVTMAX THEN GO TO BD; 06380650
IF P(DUP) GEQ J:=J+1 THEN GO UP; E:=E-NT1; J:=1 ; 06380700
PU: NT2:=(NT3:=P(M[B+J],DUP).STARTWRD)+NT5:=P(XCH) AND NUMENTM ; 06380750
IF P(DUP)!J THEN IF (NT2-1)DIV 30=(NT4~M[B+J+1].STARTWRD)DIV 30 THEN06380800
MOVE(NT1~NT2 MOD 30,UA[NEU1]+NT5-NT1,NT1~UA[NEU1+1]-NT4 MOD 30); 06380850
DISKWAIT(UA[NEU1]-NT1~NT3 MOD 30,NT1~NT5,USERDISKBOTTOM+NT3 DIV 30);06380900
$ SET OMIT = NOT(SHAREDISK) 06380924
FORGETSPACE(UA[NEU2+J]); 06380950
IF P(DUP) GEQ J:=J+1 THEN GO PU ; 06381000
$ SET OMIT = SHAREDISK 06381020
MOVE(NT,[UA[NT+NT]].[AVTABLE[1]]) ; 06381070
$ POP OMIT 06381071
$ SET OMIT = NOT(SHAREDISK ) 06381075
FORGETSPACE(UA) ; 06381085
$ SET OMIT = NOT(SHAREDISK ) 06381095
P(DEL,Q&AVS[TOSIZE] OR M,RTN) ; 06381250
L3: P(U[NEUP.NEUF+2+(Q:=J DIV P(M1)) DIV 2],IF Q THEN P.[8:20] ELSE 06381300
P.[28:20]) ; 06381310
IF U[Q+1].SPEED = 2 THEN 06381320
BEGIN % 40-MILL MASK CONSTRUCTION. 06381330
Q:=P ; 06381335
STREAM(S:=0:Q); 06381340
BEGIN 06381345
SI:=LOC Q; SKIP 28SB; DI:=LOC S; SKIP 8DB; 06381350
5(4(IF SB THEN DS:=SET ELSE SKIP DB;SKIP SB); SKIP 4 DB); 06381355
SI:=LOC Q; SKIP 28 SB; DI:=LOC S; DI:=DI+2; 06381360
5(4(IF SB THEN DS:=SET ELSE SKIP DB;SKIP SB); SKIP 4 DB); 06381365
END STREAM; 06381380
END ; 06381390
STREAM(MSG:=0:V:=47-(J:=((Q:=J MOD P(M1))+ABS(R)-1) DIV P(T10)), 06381395
W:=1+J-Q DIV P(T10)); 06381400
BEGIN DI:=LOC MSK; SKIP V DB; DS:=W SET; END; 06381405
P(LND,LNG,0,LNG,=,RTN); 06381410
M1::: @3641100; % DECIMAL 1000000. 06381450
T10::: @23420; % DECIMAL 10000. 06381500
END OF USERDISKSPECIALCASE ; 06381550
PROCEDURE GETMOREOLAYDISK(MIX);% 06400000
VALUE MIX;% 06401000
INTEGER MIX;% 06402000
BEGIN INTEGER I=+1,% 06403000
J=+2,% 06404000
T=+3;% 06405000
ARRAY A=+4[*];% 06406000
REAL MSCW=-2; 06406500
REAL RCW=+0;% 06407000
LABEL EXIT;% 06408000
DEFINE DALOCMAXSZ = 06408100
$ SET OMIT = NOT(AUXMEM) 06408199
$ SET OMIT = AUXMEM 06408299
127#; %DALOC SIZE MUST = 9 INIITALLY. 06408300
$ POP OMIT 06408301
P(0, 0, 0, 0); TOGLE ~ TOGLE OR STACKMASK;% 06410000
IF (T~DALOC[MIX,0].[CF]+1)=DALOCMAXSZ THEN BEGIN 06411000
TERMINATE (MIX&111[CTF]); %517-06411010
GO TO EXIT; END; 06411030
IF T=DALOCROW[MIX].[8:10] THEN% 06412000
BEGIN IF (J~T+P(DUP) - 1)=129 THEN J~DALOCMAXSZ; 06413000
WHILE (I := GETSPACE(J, 0, 3)+2)=2 DO 06414000
SLEEP([CLOCK], NOT CLOCK); 06415000
MOVE(T, DALOCROW[MIX], I); 06416000
FORGETSPACE(DALOCROW[MIX]); 06417000
DALOCROW[MIX] := (*P(DUP)) & I[CTC] & J[8:38:10]; 06417500
M[I-2].[9:6] := MIX; 06418000
END AIT TYPE ACTION;% 06419000
IF (I ~ GETUSERDISK(500 OR MEMORY))=0 THEN GO TO EXIT;% 06420000
DALOC[MIX,0] ~ (*P(DUP))&(T+1)[CTC];% 06421000
DALOC[MIX,T] ~ I;% 06422000
DALOC[MIX,T+1] ~ 0;% 06423000
EXIT: OLAYMASK ~ TWO(MIX) OR OLAYMASK;% 06424000
KILL([MSCW]); 06425000
END GET MORE OVERLAY DISK FOR A MIX INDEX;% 06426000
REAL PROCEDURE SECURITYCHECK(MID,FID,USERID,HEADER); 06460000
VALUE MID,FID,USERID; 06460100
REAL MID,FID,USERID,HEADER; 06460200
% MID MULTI FILE ID OF FILE TO BE CHECKED 06460300
% FID FILE ID OF FILE TO BE CHECKED 06460400
% USERID USER IDENTIFICATION 06460500
% HEADER 06460600
% >512 CORE ADDRESS OF HEADER IN 33:15. JUST CHECK IT. 06460700
% >0, <512 VALUE FOR DIRECTORYSEARCH, FIND THE FILE AND PASS 06460800
% BACK THE HEADER IN ADDITION TO SECURITY INFO. 06460900
% <0 DISK ADDRESS OF HEADER. READ IT IN AND CHECK IT, BUT 06460950
% DONT PASS IT BACK. 06460960
% 06461100
% RESULT FROM SECURITYCHECK 06461200
% =0 NO LEGITIMATE USER FOUND 06461300
% =2 TERTIARY USER ( INPUT ONLY) 06461400
% =3 SECONDARY USER (INPUT/OUTPUT) 06461500
% =7 PRIMARY USER (INPUT/OUTPUT/LIB MAINT.) 06461600
BEGIN 06462000
REAL T2,DKSGROW,CODES,ROWS,ROW,DKADR,ROWSZ,C,USER,TYPE,SH; 06462100
REAL I=DKSGROW, FPBSIZE=CODES; 06462105
ARRAY FH[*],FPB=ROW[*]; 06462110
LABEL FOUND; 06462120
LABEL EXYT,NOTFOUND,LOOK,WHY,FORGET; 06462200
REAL SUBROUTINE DIRSRH; 06463000
BEGIN 06463100
LOOK: IF (T2:=DIRECTORYSEARCH(MID,FID,HEADER)) LSS 64 THEN 06463200
WHY: BEGIN 06463210
IF T2=0 THEN FILEMESS("#NO FIL","ON DISK",MID,FID,0,0,0) 06463220
ELSE IF T2=1 THEN BEGIN P(DEL); TYPE:=-1; GO EXYT; END 06463225
ELSE IF T2=2 THEN FILEMESS("#SYSFIL","ERROR ", 06463230
MID,FID,0,0,0); 06463240
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-06463260
BEGIN %747-06463270
REPLY[P1MIX]:=-(SH:=VWY&VOK[36:42:6]&VIL[30:42:6]); 06463280
COMPLEXSLEEP((REPLY[P1MIX] GTR 0) OR TERMSET(P1MIX)); 06463300
END; 06463310
IF TERMSET(P1MIX) THEN GO INITIATE; 06463340
IF NOT WHYSLEEP(SH) THEN GO TO WHY; 06463360
IF (SH~T2~REPLY[P1MIX].[FF]) > PSEUDOMAXT THEN % IL%540-06463380
BEGIN STREAM(T2:); 06463400
BEGIN SI:=T2; 06463420
LL: SI:=SI+1; IF SC!"L" THEN GO TO LL; 06463440
SI:=SI+1; T2:=SI; 06463460
END; 06463480
T2:=P; 06463500
FPBSIZE:=(FPB:=PRT[P1MIX,3]).[8:10]; 06463520
FOR I:=0 STEP ETRLNG UNTIL FPBSIZE DO 06463540
IF (FPB[I] EQV MID)=NOT 0 THEN 06463560
IF (FPB[I+1] EQV ABS(FID))=NOT 0 THEN GO FOUND; 06463580
FOUND: NAMEID(C,T2); MID:=C; NAMEID(C,T2); 06463600
NAMEID(C,T2); FID:=C&FID[1:1:1]; 06463620
IF I LSS 1020 THEN 06463640
BEGIN FPB[I]:=MID; 06463660
FPB[I+1]:=C; 06463680
END; 06463700
FORGETSPACE(SH-1); 06463720
END ELSE LABELTABLE[T2]:=-(*P(DUP)); %764-06463740
REPLY[P1MIX]:=0; 06463760
GO TO LOOK; 06463780
END; 06463800
DIRSRH := T2; 06463810
END DIRSRH; 06463820
IF HEADER GEQ 0 THEN 06463840
SH:=IF HEADER GTR 511 THEN HEADER ELSE DIRSRH 06463860
ELSE DISKWAIT(-(SH:=SPACE(30)),30,HEADER.[CF]); 06463880
FH:=IOQUE&SH[CTC]; 06463900
IF(FH[2] EQV 0)=NOT 0 OR (ABS(USERID) EQV ABS(FH[2]))=NOT 0 06463910
OR (USERID EQV MCP)=NOT 0 THEN TYPE+7 ELSE% 06463920
IF HEADER<0 THEN GO EXYT ELSE 06463925
IF (FH[5] EQV @14)=NOT 0 THEN% 06463930
IF (FH[6] EQV @14)=NOT 0 THEN TYPE~2 ELSE TYPE~3;% 06463940
IF TYPE ~ 0 THEN GO TO EXYT; 06463950
IF FH[5].[1:1] THEN 06463960
BEGIN IF (SH:=DIRECTORYSEARCH(ABS(FH[5]),FH[6],19))=0 06463970
THEN BEGIN TYPE:=0; GO TO EXYT END; 06463980
M[SH+4].[11:1]:=1; 06463982
STREAM(DATE,J:=5); BEGIN SI:=LOC DATE; DS:=8OCT; END; 06463984
M[SH+3].[12:18]:=JUNK; 06463986
DISKWAIT(SH.[CF],-30,SH.[FF]); 06463988
$ SET OMIT = SHAREDISK 06463990
UNLOCKDIRECTORY; 06463992
$ POP OMIT 06463994
DKSGROW:=M[SH INX 8]; 06463996
CODES:=SPACE(30); 06464000
ROWS:=(M[SH INX 9] AND 31)-1; 06464050
FOR ROW:=0 STEP 1 UNTIL ROWS DO 06464100
BEGIN IF (DKADR:=M[SH INX 10+ROW])=0 THEN 06464200
NOTFOUND: BEGIN TYPE := 0; 06464300
FORGETSPACE(CODES); FORGETSPACE(SH);GO TO EXYT; 06464400
END; 06464500
ROWSZ := DKADR + DKSGROW; 06464600
WHILE DKADR < ROWSZ DO 06464700
BEGIN DISKIO(C,1-CODES,30,DKADR); 06464800
SLEEP([C],IOMASK); 06464900
FOR C:=0 STEP 1 UNTIL 29 DO 06465000
BEGIN IF((USER:=NFLAG(M[CODES INX C]))EQV @114= 06465100
NOT 0 THEN GO TO NOTFOUND; 06465200
IF (USER EQV @14)! NOT 0 THEN 06465210
IF USER.[3:3]=0 THEN 06465220
BEGIN 06465230
IF (USERID EQV ABS(USER))=NOT 0 THEN 06465300
BEGIN TYPE := 06465400
IF USER < 0 THEN 2 ELSE 3; 06465500
GO TO FORGET; 06465600
END; 06465700
END ELSE 06465800
BEGIN 06465805
IF P1MIX ! 0 THEN 06465810
IF (ABS)JAR[P1MIX,0])EQV 06465820
USER.[6:42])= NOT 0 THEN 06465830
IF((IF JAR[P1MIX,0]<0 THEN "DISK "ELSE JAR[P1MIX,1])EQV 06465840
M[CODES INX C+1].[6:42])= NOT 0 06465850
THEN 06465860
BEGIN 06465870
TYPE := USER.[3:3]; 06465880
GO TO FORGET; 06465900
END; C:=C+1; 06465910
END; 06465920
END; % 30 USERS 06466000
DKADR := DKADR + 1; 06466100
END; % ROW 06466200
END; % ROWS 06466300
GO TO NOTFOUND; 06466310
END; % NO SECURITY BLOCK FILE 06466400
TYPE :=0; 06466500
EXYT: 06466600
IF HEADER LSS 512 THEN 06466610
IF HEADER GEQ 0 THEN HEADER:=FH ELSE FORGETSPACE(FH); 06466620
SECURITYCHECK :=TYPE; 06466700
END SECURITYCHECK; 06467500
$ SET OMIT = NOT(DATACOM ) 06499999
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *%JS06845900
$ SET OMIT = NOT(DCLOG AND DATACOM ) 06845999
DEFINE KLULMP=@174#; @173 IS RESERVED FOR THE DISK ADDRESS 07000000
COMMENT LASTCDNUM, FIRSTDECK, AND LASTDECK ARE STORED IN THE 07000010
FIRST THREE WORDS OF THE DISK SEGMENT LOCATED AT DIRECTORYTOP 07000015
+3. IN A NON SHARED DISK SYSTEM, THEY ARE WRITTEN OUT EACH 07000020
TIME ONE OF THEM IS CHANGED SO THAT THEY WILL BE PRESERVED 07000025
IF A HALT/LOAD OCCURS. N A SHARED DISK SYSTEM, THEY ARE 07000030
READ INTO THE PRT WITH A READ-LOCK COMMAND EACH TIME THEY ARE 07000035
USED. THIS PROVIDES CONTROL DECK INTERLOCKING BETWEEN SYSTEMS 07000040
IN ADDITION TO PASSING THE INFORMATION BETWEEN SYSTEMS. 07000045
END COMMENT; 07000050
INTEGER LASTCDNUM=@174; 07000100
REAL FIRSTDECK=@175; 07000200
REAL LASTDECK=@176; 07000300
DEFINE LOCKCONTROLDECKS=BEGIN SLEEP([TOGLE],CDMASK); LOCKTOG(CDMASK); 07001000
$ SET OMIT = NOT(SHAREDISK) 07001099
END#, 07001200
UNLOCK(CONTROLDECKS=BEGIN 07001300
$ SET OMIT = NOT(SHAREDISK) 07001399
UNLOCKTOG(CDMASK) END#; 07001500
REAL PROCEDURE NEXTCDNUM(UPDATE); VALUE UPDATE; BOOLEAN UPDATE; 07001600
BEGIN 07001620
LOCKCONTROLDECKS; 07001640
LASTCDNUM := (LASTCDNUM MOD 9999) + 1; 07001660
STREAM(CDNUM:=0; LNUM:=LASTCDNUM); 07001680
BEGIN 07001700
SI:=LOC LNUM; DI:=LOC CDNUM; DS:=8 DEC; 07001720
END; 07001740
NEXTCDNUM := P; 07001760
IF UPDATE THEN 07001780
BEGIN 07001800
DISKWAIT(KLUMP,-3,DIRECTORYTOP+3); 07001820
UNLOCKTOG(CDMASK); 07001840
END; 07001860
END; 07001880
PROCEDURE STARTADECK(N); VALUE N; REAL N; FORWARD; 07002000
PROCEDURE ENTERCONTROLDECK(H); VALUE H; ARRAY H[*]; FORWARD; 07002100
REAL RUNNUMBER;% 07003000
%891-07003250
%#######################################################################07003251
%891-07003252
PROCEDURE EBTABLE; %890-07003270
BEGIN LABEL L; %890-07003280
P(0,XIT,.L,DEL); %890-07003290
L::: %890-07003300
0," 32?","1???","0TS?","/???","-LK?","J???","????","????","&CB?","A???",07003310
"!???","????","????","????","????",""????", %890-07003312
"9???","????","Z???","????","R???","????","????","????","I???","????", 07003320
"????","????","????","????","????","????", %890-07003322
"8#:?","????","Y,|?","????","Q$]?","????","????","????","H.[?","????", 07003330
"????","????","????","????","????","????", %890-07003332
@07770675,@05770413,@067146616,@65176473, %892-07003340
@47574656,@45554453,"????","????", @27742620,@25352436, %890-07003342
"????","????","????","????","????","????", %891-07003344
%QMARKADDRESSES %890-07003350
"????","????","????","????","????","????","????","????","????","????", 07003352
"????","????","????","????","????","????", %890-07003354
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % SPACE FOR ADDRESSES %890-07003360
0,0,0,0,0,0,0; %890-07003370
END; %890-07003380
%891-07003390
%#######################################################################07003391
%891-07003392
PROCEDURE SETUPEBTABLE; %890-07003400
BEGIN REAL ADR; LABEL EXIT; %890-07003410
DEFINE STOREADDRESS= %890-07003412
X:=SI; SI:=LOC X; SI:=SI+5; %890-07003414
DS:=3 CHR; DI:=DI+5 #; %890-07003416
EBTABLE; %890-07003420
P([M[(ADR:=*P(.EBTABLE) INX NOT 1)]],IOR); %890-07003430
SETUPEBTABLE:=ADR:=ADR.[CF]+3; %890-07003440
IF M[ADR+81] = 0 THEN %890-07003450
STREAM (X:=0,TABLE:=ADR,QMARKTABLEADDRESS:=ADR+32,LOCATIONS:=ADR+40); 07003462
BEGIN %890-07003464
DI:=TABLE; SI:=TABLE; SI:=SI+8; %890-07003466
2(40(SI:=SI+4; DS:=4 CHR;)); %890-07003468
%FIRST FILL ALL OF ADDRESSES WITH ADDRESS OF ?S %890-07003482
SI:=QMARKTABLEADDRESS; %890-07003484
X:=SI; %890-07003486
SI:=LOC X; SI:=SI+5; %POINT SI AT ADDRESS OF QMARKS %890-07003488
DI:=LOCATIONS; %890-07003490
DS:=3 CHR; %890-07003492
SI:=LOCATIONS; %890-07003494
DS:=63 WDS; %890-07003496
%NOW SET ADDRESSES FOR VALID CHARS INTO EBCDIC TABLE %890-07003498
SI:=TABLE; %890-07003500
DI:=LOCATIONS; %890-07003502
3(STOREADDRESS; %STORE ADDRESSES FOR LP=0,1,2 %890-07003504
%CORRESPONDING TO BLANK,9 HOLE,8 HOLE %890-07003506
SI:=X; %890-07003508
SI:=SI+63; SI:=SI+1); %SKIP 8 WORDS DOWN TABLE %890-07003510
DI:=DI+8; %LP=3 IN INVALID %890-07003512
STOREADDRESS; %LP=4..... 7 HOLE %890-07003514
DI:=DI+8; %LP=5 IS INVALID %890-07003516
SI:=X; %890-07003518
SI:=SI+1; %SKIP 1 CHAR DOWN TABLE %890-07003520
STOREADDRESS; %LP=6....7&8 HOLES TOGETHER %890-07003522
DI:=DI+8; %890-07003524
SI:=X; %890-07003526
SI:=SI+1; %890-07003528
STOREADDRESS; %LP=8....6 HOLE %890-07003530
DI:=DI+8; %890-07003532
SI:=X; %890-07003534
SI:=SI+1; %890-07003536
STOREADDRESS; %LP=10....6&8 HOLES TOGETHER %890-07003538
SI:=DI+40; %MISS 5 WORDS...LP=11,12,13,14,15 %890-07003540
SI:=X; %890-07003542
SI:=SI+1; %890-07003544
STOREADDRESS; %LP:=16.... 5 HOLE %890-07003546
DI:=DI+8; %890-07003548
SI:=X; %890-07003550
SI:=SI+1; %890-07003552
STOREADDRESS; %LP=18.... 5&8 HOLES TOGETHER %890-07003554
2(DI:=DI+52); %MISS 13 WORDS....LP=19-31 %890-07003556
SI:=X; %890-07003558
SI:=SI+1; %890-07003560
STOREADDRESS; %LP=32..... 4 HOLE %890-07003562
DI:=DI+8; %890-07003564
SI:=X; %890-07003566
SI:=SI+1; %890-07003568
STOREADDRESS; %LP=34...... 4&8 HOLES TOGETHER %890-07003570
END; %890-07003580
END; %890-07003590
%***********************************************************************07003600
STREAM PROCEDURE EBCDICCONVERT(INTO,TABLE,POINTERS); %890-07003610
VALUE INTO,TABLE,POINTERS; %890-07003615
%***********************************************************************07003620
BEGIN %890-07003630
LOCAL HP,LP,SRCE,DEST,HPPTR,LPPTR; %890-07003640
%POINT HPPTR & LPPTR TO LAST CHAR OF HP,LP %890-07003650
SI:=LOC HP; %890-07003660
SI:=SI+7; %890-07003670
HPPTR:=SI; %HIGH PART %890-07003680
SI:=LOC LP; %890-07003690
SI:=SI+7; %890-07003700
LPPTR:=SI; %LOW PART %890-07003710
SI:=INTO; SI:=SI+8; %890-07003720
DI:=INTO; %890-07003730
%START CHARACTER TRANSLATE LOOP %890-07003740
2(40( %890-07003750
DEST:=DI; %890-07003760
%TRANSFER LOW & HIGH PARTS %890-07003770
DI:=HPPTR; %890-07003780
DS:=1 CHR; %890-07003790
DI:=LPPTR; %890-07003800
DS:=1 CHR; %890-07003810
SRCE:=SI; %STORE SI FOR NEXT PASS THRU LOOP %890-07003820
%NOW FIND THE POINTER INTO TABLE APPROPRIATE TO LP %890-07003830
SI:=POINTERS; %890-07003840
LP(SI:=SI+8); %890-07003860
SI:=SC; %SI NOW POINTS INTO TABLE @ POINT DEPENDANT ON LP %890-07003870
DI:=DEST; %890-07003880
SI:=SI+HP; %SKIP SI THROUGH TABLE HP CHARS %890-07003890
DS:=CHR; %890-07003900
SI:=SRCE)); %890-07003910
DI:=TABLE; DI:=DI+3; %POINT TO QMRK %890-07003920
END CONVERT; %890-07003950
PROCEDURE COM23;% 07004000
BEGIN% 07005000
REAL INBUFF,% ADDRESS OF THE INPUT BUFFER. 07006000
OUTBUFF,% " " " OUTPUT BUFFER. 07006010
FIRSTCARD,% " " " CARD IMAGE OF THE FIRST CARD 07006020
OUTBUFFOLD,% " " " LAST OUTPUT BUFFER. 07006030
RESERVE,% " " 30 WDS OF CORE USED TO BUILD THE 07006040
T,T1,T2,% TEMPORARY VARIABLES. 07006050
R,L,N,% " " USED TO COUNT CARD IMAG 07006060
Q,% USUALLY INDICATES COL 1 HAS A QUESTION MARK 07006070
IU,% UNIT NUMBER OF THE INPUT UNIT. 07006080
OU,% " " " " OUTPUT UNIT. 07006090
FIRST,% TRUE IF THE FIRST CARD OF A DECK. 07006100
S,% USED AS A TEMPROARY VARIABLE IN SUBROUTINE 07006140
% AND TO HAND THE UNIT NUMBER TO SUBROUTINE S 07006150
D;% USED AS A MASK TO SLEEP UNTIL DISK OPERATIO 07006160
% ARE COMPLETED. 07006161
$ SET OMIT = NOT(PACKETS) 07006169
REAL VERYFIRST, %TRUE IF THE FIRST CARD OF THE FIRST DECK 07006172
%IN SINCE LOAD CONTROL WAS EXECUTED. 07006174
FIRSTORSEC, %TRUE IF THE FIRST OR SEC. CARD OF NEW DECK 07006176
PTYPE,% CONTAINS THE RESULT OF REAL SUBROUTINE 07006180
% PACKETCARD.SAVING SOME NEEDLESS EXTRA 07006190
% CALLS ON IT TO CHECK THE TYPE OF A CARD. 07006200
% THE VALUE OF PTYPE IS AS FOLLOWS: 07006210
% 0 = NOT A PACKET CONTROL CARD 07006220
% 1 = "PACKEND"CARD, (USED BY THE 07006230
% OPERATORS TO END A GROUP 07006240
% OF PACKETS BEING LOADED TO 07006250
% DISK) 07006260
% 3 = "PACKET" CARD,(FIRST CARD 07006270
% OF A PACKET) 07006280
% 5 = "END PACKETS" CARD, (USED BY 07006290
% THE OPERATORS TO BOTH END 07006300
% A GROUP OF PACKETS AND 07006310
% SIMULTANEOUSLY DISCONTINUE 07006320
% LOAD CONTROL). 07006330
PLUGGED;% TRUE IF THE LAST "PACKET" CARD(I.E., 07006340
% PTYPE=3), WAS BOTH THE START OF A NEW 07006350
% PACKET AND WAS USED TO "PLUG" THE END 07006360
% OF THE LAST PACKET WITH AN ARTIFICIAL 07006370
% "-QUESTION MARK- PACKET." CARD; 07007000
$ POP OMIT 07007001
BOOLEAN CDONLY; 07007100
INTEGER A,I;% 07008000
$ SET OMIT = NOT(PACKETS) 07008199
REAL CONTINUE,DISKCHAIN,ADECK; LABEL OK; 07008200
$ POP OMIT 07008251
LABEL AGAIN,INL,ERROR,SUPER,BOMB,SKIPIT,EXIT; 07009000
LABEL INPUTL; 07009100
BOOLEAN EBCDIC; REAL EBTABLEADR; %890-07009200
ARRAY FPB[*],H[*];% 07010000
SUBROUTINE STOP;% 07011000
BEGIN IF S ! 18 THEN% 07012000
BEGIN READY ~ NOT(Q ~ TWO(S)) AND READY;% 07013000
RRRMECH ~ NOT Q AND RRRMECH OR Q AND SAVEWORD;% 07014000
LABELTABLE[S] ~ @114;% 07015000
RDCTABLE[S] ~ MULTITABLE[S] ~ 0% 07016000
END;% 07017000
FPB[T+1]~ *P(DUP)+CLOCK+P(RTR);% 07018000
FPB[T].[24:12] ~ TINU[S].[18:12];% 07019000
TINU[S].[18:12]:=0; 07020000
END;% 07021000
$ SET OMIT = PACKETS 07021999
$ SET OMIT = NOT(PACKETS) 07022099
SUBROUTINE FORGETONE; 07022100
$ POP OMIT 07022101
BEGIN T1 ~ H[9]+9;% 07023000
FOR T2 ~ 10 STEP 1 UNTIL T1 DO% 07024000
FORGETUSERDISK(H[T2],-H[8]); 07025000
END;% 07026000
$ SET OMIT = NOT(PACKETS) 07026099
SUBROUTINE FORGETIT; 07026100
BEGIN FORGETONE; 07026200
WHILE DISKCHAIN NEQ 0 DO 07026300
BEGIN DISKWAIT(-(H INX 0),30,DISKCHAIN); 07026400
DISKCHAIN:=H[6].[FF]; 07026500
FORGETONE; 07026600
END; 07026700
END FORGETIT; 07026800
$ POP OMIT 07026801
SUBROUTINE BOMBTIME;% 07027000
BEGIN WHILE STOPSET(P1MIX) DO STOPM(FALSE); 07028000
IF TERMSET(P1MIX) THEN GO BOMB; END; 07028100
$ SET OMIT = NOT(PACKETS) 07028999
REAL SUBROUTINE PACKETCARD;% THIS USED TO BE "ENDCARD" 07029000
BEGIN IF Q THEN% 07030000
BEGIN;% 07031000
IF EBCDIC THEN %890-07031200
BEGIN %890-07031300
EBCDIC:=FALSE; %890-07031400
M[(*P(.EBTABLE) INX NOT 1)].[2:1]:=0; %890-07031500
END; %890-07031600
STREAM(X:="PACKETS":Y:="CONTINU",Z:="END. ", %890-07032000
EB:="DATA029",INBUFF); %890-07032100
BEGIN SI ~ INBUFF;% 07033000
L: SI ~ SI+1; IF SC = " " THEN GO TO L;% 07034000
INBUFF:=SI; %890-07034500
DI~LOC X; DI~DI+1;% POINT TO "PACKETS" 07035000
IF 4SC=DC THEN% A "PACKET" OR "PACKEND" CARD 07036000
IF 2SC=DC THEN TALLY~3% A "PACKET" CARD 07036100
ELSE TALLY~1% A "PACKEND" CARD 07036150
ELSE BEGIN DI~DI-4;% POINT TO "PACKETS" 07036200
IF 7 SC=DC THEN TALLY:=5 %"END PACKET" 07036210
ELSE BEGIN SI:=INBUFF;DI:=LOC Y; %890-07036220
DI:=DI+1;IF 7SC=DC THEN TALLY:=6 07036230
ELSE BEGIN DI:=LOC Z;DI:=DI+1; 07036240
SI:=INBUFF; %890-07036250
IF 3 SC=DC THEN TALLY:=7 %890-07036260
ELSE BEGIN %890-07036270
DI:=LOC EB;DI:=DI+1 %890-07036280
SI:=INBUFF; 07036290
IF 6 SC=DC THEN %890-07036300
$VOID %890-07036310
TALLY:=4; 07036320
$ VOID 07036351 %890-07036330
END END END; %890-07036390
END;% 07036400
X ~ TALLY;% 07037000
END;% 07038000
END ELSE P(0);% 07039000
PTYPE:=P; 07039100
IF PTYPE=6 THEN BEGIN PTYPE:=3; CONTINUE:=TRUE END 07039200
ELSE CONTINUE:=FALSE; 07039300
IF PTYPE=7 THEN PTYPE:=ADECK; 07039410
IF PTYPE = 4 THEN %890-07039500
BEGIN PTYPE:=0; EBCDIC:=TRUE; %890-07039600
EBTABLEADR:=SETUPEBTABLE; %890-07039700
END; %890-07039800
PACKETCARD:=PTYPE; 07040000
END;% 07041000
$ POP OMIT 07041001
$ SET OMIT = PACKETS 07041099
REAL SUBROUTINE ADR;% 07042000
BEGIN IF (T2 ~ H[(T1 ~ R DIV 200)+10]) = 0 THEN% 07043000
BEGIN H[9] ~ T1+1;% 07044000
H[T1+10] ~ T2 ~ GETUSERDISK(200);% 07045000
END;% 07046000
ADR ~ R MOD 200+T2% 07047000
END;% 07048000
SUBROUTINE INPUT;% 07049000
BEGIN% 07050000
IF IU < 16 THEN% 07051000
$ SET OMIT = NOT(PACKETS) 07051099
BEGIN 07051100
INPUTL: T ! WAITIO (@120540000000 + INBUFF, 07051110
@6000040, IU); 07051120
IF T=@40 THEN GO TO INPUTL; 07051130
IF T!0 THEN 07051140
BEGIN 07051150
P(DEL); 07051160
GO TO ERROR 07051170
END; 07051180
$ POP OMIT 07051181
$ SET OMIT = PACKETS 07051999
Q ~ M[INBUFF-1]=9;% 07057000
END% 07058000
ELSE BEGIN WHILE(Q:=WAITIO(@40000000+INBUFF+ %890-07059000
EBCDIC|@400000001,FIRST|4+ %890-07059010
@4000000,IU).[45:1] DO 07059100
IF FIRST AND CDONLY AND NOT CONTINUE THEN %654-07059110
GO EXIT ELSE %654-07059112
BEGIN SLEEP([TOGLE],STATUSMASK); 07059200
RRRMECH~RRRMECH AND NOT Q~TWO(IU); 07059300
READY~READY AND NOT Q; 07059400
SLEEP([READY],Q); 07059500
END; 07060000
IF EBCDIC THEN EBCDICCONVERT(INBUFF, %890-07060100
EBTABLEADR,EBTABLEADR+40) ELSE %890-07060200
IF Q ~ Q ! 0 THEN 07061000
BEGIN S:=(T:=UNIT[IU]).[FF]; 07062000
RETURNIOSPACE(S); 07063000
UNIT[IU] ~ T&@77777[5:20:28]; 07065000
END;% 07066000
STREAM(QMK:=12:BCL:=1-EBCDIC,INBUFF); %890-07066100
BEGIN %890-07066200
SI:=INBUFF; %890-07066300
BCL (IF SC=""" THEN JUMP OUT TO L1); 07066350
IF SC=@14 THEN %890-07066400
L1: BEGIN SI:=LOC QMK;SI:=SI+7; %890-07066500
DS:=1 CHR; %890-07066550
TALLY:=1; %890-07066600
SI:=INBUFF; %890-07066610
2(36(IF SC=">" THEN %890-07066620
BEGIN INBUFF:=SI; DI:=INBUFF; %890-07066630
DS:=LIT "="; %890-07066635
END; %890-07066640
IF SC="}" THEN %890-07066650
BEGIN INBUFF:=SI; DI:=INBUFF; %890-07066660
DS:= LIT """ %890-07066665
END; SI:=SI+1;)) %890-07066670
END; %890-07066700
QMK :=TALLY; %890-07066800
END; %890-07066850
Q:=P OR Q; %890-07066900
T = 0;% 07067000
END;% 07068000
END INPUT; % -07069000
%---------------- COM23 ------------------- -07069200
$ SET UP INPUT VARIABLES% 07071000
IF CDONLY:=(PRT[P1MIX,@25]>22) THEN 07072000
BEGIN IU:=PRT[P1MIX,@25]; 07072100
PRT[P1MIX,@25]:=0; % DISK 07072200
END ELSE 07072300
BEGIN IF (IU:=FINDINPUT("CONTROL","DECK ",0,0,0,0,0,0, 07072400
0,0)) LSS 0 THEN GO INITIATE; % BEEN DS-ED 07072500
IF IU GEQ 32 THEN P(XIT); % EOJ IF PSEUDODCK07072600
END; 07072700
STARTIMING(0,IU); 07073000
FPB:=PRT[P1MIX,3]; 07073500
$ SET OMIT = PACKETS 07073999
IF NOT(JAR[P1MIX,9].[2:1]) THEN % DONT SUPPRESS MESSAGE 07074090
FILEMESSAGE(" IN "&TINU[IU][6:30:18],0, 07074100
"CONTROL","DECK ",0,0,0,OPNMESS); 07074200
RDCTABLE[IU].[8:6] ~ P1MIX;% 07075000
IF IU LSS 16 THEN BEGIN% 07076000
FPB[3].[23:1]:=1; %SET INPUT FLAG FOR LOG 07076010
T ~ WAITIO(@540000005,0,IU)% 07077000
END% 07077010
ELSE IF IU=23 AND READERA NEQ 0 THEN 07078000
BEGIN FORGETSPACE(READERA-2);% 07079000
READERA ~ 0;% 07080000
END% 07081000
ELSE IF IU=24 AND READERB NEQ 0 THEN 07082000
BEGIN FORGETSPACE(READERB-2);% 07083000
READERB ~ 0;% 07084000
END;% 07085000
$ VOIDT %890-07086000
FIRSTCARD ~ GETSPACE(10,CONTROLCARDAREAV,1)_2);% %167-07087000
% SET UP OUTPUT VARIABLES% 07088000
IF PRT[P1MIX,@25] THEN% 07089000
BEGIN OU ~ LABELASCRATCH(T ~% 07090000
TAPELABEL("CONTROL","DECK ",1,1,100));% 07091000
IF OU<0 THEN GO INITIATE; %BEEN DS-ED 07091100
FORGETSPACE(I);% 07093000
FPB[3].[23:1]:=0; %SET OUTPUT FLAG FOR LOG 07093010
END% 07094000
ELSE BEGIN OUTBUFFOLD ~ OUTBUFF ~% %167-07095000
GETSPACE(60,IOBUFERAREAV,1)+2;% %167-07095100
RESERVE ~ GETSPACE(30,0,1)+2;% 07096000
H := SAVEARRAYDESC(30,DISKHEADERAREAV); %167-07097000
OU ~ 18;% 07098000
INBUFF ~ GETSPACE(21,IOBUFFERAREAV,1) + 2; %892-07101000
END;% 07103000
STARTIMING(5,OU); 07104000
FPB:=PRT[P1MIX,3]; % STARTIMING MAY HAVE MOVED IT. 07104500
$ SET OMIT = NOT(PACKETS) 07105499
VERYFIRST~1;% 07105500
$ POP OMIT 07105501
% BEGIN ONE DECK% 07106000
AGAIN: OUTBUF ~ OUTBUFFOLD;% 07107000
L ~ N ~ 0;% 07108000
$ SET OMIT = NOT(PACKETS) 07108099
ADECK ~ 0; FIRSTORSEC ~ %178-07108100
$ POP OMIT 07108101
FIRST ~ D ~ 1; 07109000
IF OU = 18 THEN% 07110000
BEGIN H[ 9] ~ 0;% 07111000
MOVE(20,[H[9]],[H[10]]); 07112000
H[8]~200; 07112100
END;% 07113000
% BEGIN ONE CARD% 07114000
INL: 07115000
$ SET OMIT = NOT(PACKETS) 07115099
IF PTYPE NEQ 3 OR VERYFIRST THEN 07115100
$ POP OMIT 07115101
INPUT; 07115200
$ SET OMIT = NOT(PACKETS) 07115499
IF FIRSTORSEC THEN% 07115500
$ POP OMIT 07115501
IF FIRST THEN% 07116000
BEGIN 07117000
$ SET OMIT = NOT(PACKETS) 07117099
PLUGGED:=VERYFIRST; 07117100
$ POP OMIT 07117101
$ SET OMIT = PACKETS 07117199
MOVE(10,INBUFF,FIRSTCARD);% 07118000
$ SET OMIT = NOT(PACKETS) 07118099
IF PACKETCARD=5 THEN %124-07118500
IF OU<16 THEN FIRST:=VERYFIRST:=0 ELSE 07118510
GO TO EXIT ELSE 07118520
IF PTYPE!3 OR CONTINUE THEN 07118550
BEGIN 07118600
ADECK:=1; GO DK; 07118690
END; 07118700
END ELSE% THIS MUST BE THE SECOND CARD IN 07119000
$ POP OMIT 07119001
$ SET OMIT = PACKETS 07119009
$ SET OMIT = NOT(PACKETS) 07119099
DK: IF Q THEN FIRSTORSEC:=0 ELSE%BAD SEC./FIRST 07119100
BEGIN VERYFIRST+4; % CARD 07119200
GO TO ERROR;% 07119300
END;% INV DECK SET-UP 07119400
$ POP OMIT 07119401
IF T NEQ 0 THEN 07120000
$ SET OMIT = NOT(PACKETS) 07120009
IF PTYPE NEQ 3 OR VERYFIRST THEN 07120010
$ POP OMIT 07120011
GO TO ERROR; 07120020
BOMBTIME;% 07121000
IF OU < 16 THEN % OUTPUT TO TAPE ( OU = 18 NORMALLY) -07122000
BEGIN 07122010
$ SET OMIT = NOT(PACKETS) 07122999
PLUGGED ~ VERYFIRST OR (PACKETCARD!3) 07123500
OR FIRST; 07124000
IF PLUGGED THEN 07124500
$ POP OMIT 07124501
T~WAITIO(INBUFF&@5000[18:33:15] 07125000
&(10-Q)[8:38:10],0,OU); 07125500
$ SET OMIT = PACKETS 07125599
$ SET OMIT = NOT(PACKETS) 07125999
IF VERYFIRST THEN VERYFIRST~PTYPE~0; 07126000
IF FIRST THEN FIRST~PTYPE~0; 07126500
IF PTYPE=0 THEN GO TO INL; 07127000
$ POP OMIT 07127001
M[INBUFF-1] ~ @1737000000000000; 07127500
T ~ WAITIO(INBUFF-1,0,OU); 07128000
SUPER:: 07129000
$ SET OMIT = NOT(PACKETS) 07129099
IF PTYPE=5 THEN GO TO EXIT; 07129100
IF PTYPE=1 THEN VERYFIRST:=TRUE; 07129200
GO TO AGAIN; 07129300
$ POP OMIT 07129301
$ SET OMIT = PACKETS 07129999
END;% 07139000
IF D = 0 THEN SLEEP([D],NOT 0); 07139500
$ SET OMIT = NOT(PACKETS) 07139509
IF PACKETCARD NEQ 0 AND NOT(ADECK AND PTYPE=1) THEN 07139510
BEGIN IF NOT(PLUGGED OR FIRST) THEN% 07139511
BEGIN STREAM(D~OUTBUFF); BEGIN DS~27 LIT 07139512
"CC END...IN CASE YOUR FORGOT";DS~45LIT" " END; 07139513
IF PTYPE = 3 AND NOT CONTINUE AND NOT ADECK THEN %124-07139520
BEGIN STREAM(FIRSTCARD,T!T!SPACE(13)); 07139530
BEGIN DS~24LIT"#NO PACKEND CARD, PKT - "; SI~FIRSTCARD; 07139540
DS!9 WDS; DS~LIT"~"; 07139550
END; 07139560
SPOUT(T); 07139565
END; 07139570
END ELSE MOVE(10,INBUFF,OUTBUFF);% 07139575
END ELSE% 07139590
$ POP OMIT 07139591
MOVE(10,INBUFF,OUTBUFF);% 07140000
$ SET OMIT = NOT(PACKETS) 07140099
IF VERYFIRST THEN PLUGGED~0;% 07140100
$ POP OMIT 07140101
IF Q THEN% 07141000
BEGIN IF L DIV 6 ! N DIV 6 THEN% 07142000
BEGIN R ~ L DIV 3;% 07143000
A ~ ADR;% 07144000
DISKIO(T,1-RESERVE,30,A);% 07145000
SLEEP([T],IOMASK);% 07146000
M[I~L MOD 3|10+9+RESERVE] ~ N;% 07147000
DISKIO(T,RESERVE-1,30,A);% 07148000
SLEEP([T],IOMASK);% 07149000
END% 07150000
ELSE M[I ~(L-N)|10+9+OUTBUFF] ~ N;% 07151000
L ~ M[OUTBUFF+9] ~ N;% 07152000
END;% 07153000
IF N = 12000 THEN% 07154000
BEGIN I ~ SPACE(14);% 07155000
STREAM(FIRSTCARD,T); 07156000
BEGIN DS ~ 32 LIT% 07157000
$ SET OMIT = NOT(PACKETS) 07157099
"#MORE THAN 12000 CARDS IN PKT - "; 07157100
$ POP OMIT 07157101
$ SET OMIT = PACKETS 07157999
SI~FIRSTCARD;DS~9WDS;DS~LIT "~"; 07159000
END;% 07160000
GO TO SKIPIT; 07161000
END;% 07162000
IF (N ~ N+1) MOD 6 = 0 THEN% 07163000
BEGIN R ~ N DIV 3-2;% 07164000
A ~ ADR;% 07165000
OUTBUFF ~ OUTBUFFOLD;% 07166000
DISKIO(D,OUTBUFF-1,60,A); 07167000
END ELSE OUTBUFF ~ OUTBUFF+10;% 07169000
$ SET OMIT = NOT(PACKETS) 07169099
IF FIRST THEN FIRST~PTYPE~0;% 07169100
IF VERYFIRST THEN VERYFIRST:=PTYPE:=0; 07169110
$ POP OMIT 07169201
$ SET OMIT = NOT(PACKETS) 07169499
IF PTYPE=0 THEN GO INL; 07169500
$ POP OMIT 07169501
$ SET OMIT = PACKETS 07169999
IF D = 0 THEN SLEEP([D],NOT 0); 07171000
OUTBUFF ~ OUTBUFFOLD;% 07173000
R ~ N DIV 6|2;% 07174000
A ~ ADR;% 07175000
IF N MOD 6 ! 0 THEN 07175100
BEGIN 07175200
DISKIO(T,OUTBUFF-1,60,A);% 07176000
SLEEP([T],IOMASK);% 07177000
END;% 07178000
IF R+2 < 200 THEN 07178100
BEGIN H[8] ~ R+2; 07178200
FORGETUSERDISK(A+2,R-198); 07178300
END; 07178400
H[7]~N-1; 07179000
H[4]~H[6]~0; 07179050
H[5]:= -0; 07179100
$ SET OMIT = NOT(PACKETS) 07179199
H[6]~0&DISKCHAIN[CTF]&(IF IU<23 THEN 2 ELSE IU-23) 07179200
[2:42:6]; 07179202
IF CONTINUE THEN 07179205
BEGIN 07179210
H[2]:=NEXTCDNUM(1); 07179220
DISKCHAIN:=GETESPDISK; 07179230
DISKWAIT(H INX 0,30,DISKCHAIN); 07179250
STREAM(A:=H[2],B:=FIRSTCARD,INBUFF); 07179260
BEGIN SI:=B; DS:=8 CHR;DS:=15 LIT" CONTINUES PKT#"; 07179270
DS:=15 LIT" CONTINUES PKT#"; 07179280
SI:=LOC A; SI:=SI+4; DS:=4 CHR; DS:=LIT":"; 07179290
END; 07179300
END ELSE 07179310
BEGIN DISKCHAIN:=0; 07179320
$ POP OMIT 07179321
ENTERCONTROLDECK(H); 07180000
$ SET OMIT = NOT(PACKETS) 07180009
END; 07180010
$ POP OMIT 07180011
GO TO SUPER; 07181000
ERROR: T ~ SPACE(12);% 07214000
$ SET OMIT = NOT(PACKETS) 07214099
STREAM(FIRSTCARD,X~VERYFIRST,T);% 07214100
BEGIN SI~LOC X; SI~SI+7; IF SC="2" THEN 07214110
DS~16 LIT "#INV PKT CARD - "% 07214120
ELSE IF SC="4" THEN% 07214130
DS~16 LIT "#INV DECK,PKT - "% 07214140
ELSE DS~16 LIT "#READ ERR,PKT - ";% 07214150
$ POP OMIT 07214151
$ SET OMIT = PACKETS 07214999
SI ~ FIRSTCARD; DS ~ 9 WDS; DS ~ LIT "~";% 07217000
END;% 07218000
SKIPIT: SPOUT(T); 07219000
DO BEGIN INPUT;% 07220000
VOMVRIMW;% 07221000
$ SET OMIT = PACKETS 07221999
$ SET OMIT = NOT(PACKETS) 07222099
END UNTIL PACKETCARD NEQ 0; 07222100
$ POP OMIT 07222101
IF OU < 16 THEN% 07223000
BEGIN DO BEGIN T ~ WAITIO(@340000005,@60,OU);% 07224000
BOMBTIME;% 07225000
END UNTIL T.[42:1];% 07226000
T ~ WAITIO(@140000005,@60,OU);% 07227000
END;% 07228000
ELSE FORGETIT;% 07229000
GO TO SUPER;% 07230000
BOMB:: IF OU=18 THEN FORGETIT;% %164-07231000
EXIT: SLEEP([TOGLE]),STATUSMASK); 07232000
IF IU GEQ 23 THEN UNITCODE[IU-23]:=-0; 07232500
S ~ IU; T ~ 3; STOP;% 07233000
S ~ OU; T ~ 8; STOP;% 07234000
FORGETSPACE(INBUFF);% 07235000
FORGETSPACE(FIRSTCARD);% 07236000
IF OU > 16 THEN% 07237000
BEGIN FORGETSPACE(H);% 07238000
FORGETSPACE(OUTBUFFOLD);% 07239000
FORGETSPACE(RESERVE);% 07240000
END;% 07241000
END COM23;% 07242000
PROCEDURE STARTLOADN(KTR); VALUE KTR; REAL KTR;% 07243000
BEGIN REAL HDR,SEG0,I,F,T,C; ARRAY SHEAT[*]; 07244000
LABEL TRYAGAIN,LDCNTRL,DISK; 07244100
STREAM(K~0:KTR);% 07245000
BEGIN SI ~ KTR;% 07246000
L: IF SC = " " THEN% 07247000
BEGIN SI ~ SI+1; GO TO L END;% 07248000
DI ~ LOC K; DI ~ DI+6; DS ~ 2 CHR;% 07249000
END;% 07250000
C ~ P;% 07251000
T ~ KTR.[15:15]-1;% 07252000
IF (C NEQ "MT" AND C NEQ "DK") OR 07253000
(C = "DK" AND CDONLY ) THEN 07253100
SPOUT(T INX M[T-1]) 07254000
ELSE BEGIN C ~ C = "MT";% 07255000
TRYAGAIN: 07255100
IF (HDR:=DIRECTORYSEARCH(P(LDCNTRL),P(DISK),3)) ! 0 THEN 07256000
BEGIN 07256200
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV)]] & 30[8:38:10];%07256400
STREAM(S:=F-1, D:=F); % ZERO OUT THE SHEAT ENTRY 07256600
BEGIN 07256800
SI:=S; DS:=30 WDS; 07257000
END; 07257200
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-07257400
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 07257600
F.[FF] := HDR; % CORE ADDRESS OF HEADER IN [FF] OF PARAM. 07257800
SHEAT[7] := SEG0; % CORE ADRS.OF SEGMENT ZERO IN SHEAT[7]07258000
SHEAT[0] := P(LDCNTRL); 07258200
SHEAT[1] := P(DISK); 07258400
SHEAT[2] := 0 & LDCNTRLCODE[5:45:3] & 2[8:38:10]; 07258600
% [4:1] IN SHEET[2] MEANS SUPRESS BOJ/EOJ MESSAGES 07258800
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS 07259000
SHEAT[19] := C; % COMMON VALUE 07259200
SHEAT[20] := 4; % CORE ESTIMATE 07259400
SHEAT[21] := 150; % STACK SIZE 07259600
07259800
STREAM(A:=0 : S := P(.SCHEDULEIDS)); 07260000
BEGIN 07260200
SI:=S; 07260400
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 07260600
IF SB THEN ELSE JUMP OUT); 07260800
DS:=SET; A:=TALLY; 07261000
END STREAM STATEMENT; 07261200
07261400
I := P; 07261600
SHEAT[3].[8:10] := 1; % SCHEDULE NUMBER 07261800
SHEAT[23] := (CLOCK + P(RTR)) DIV 60; 07262000
SHEAT[24] := MCP; %131-07262100
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 07262200
STREAM(C, T); 07262400
BEGIN 07262600
DI:=DI+16; 07262800
DS:=31LIT"CC EXECUTE LDCNTRL/DISK;COMMON="; 07263000
SI:=LOC C; DS:=8DEC; 07263200
DS:=6LIT";END.~"; 07263400
END STREAM STATEMENT; 07263600
M[T] := 0; M[T+1] := 10; 07263700
SHEAT[6] := GETESPDISK & 10[18:33:15]; 07263800
DISKWAIT(T, 11, SHEAT[6].[CF]); 07264000
FORGETSPACE(T); 07264200
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 07264400
END ELSE % IF IN DIRECTORY 07265000
BEGIN 07265100
ENTERSYSFILE(2); 07265200
GO TRYAGAIN; 07265300
LDCNTRL::: "LDCNTRL"; 07265400
DISK::: "DISK "; 07265500
END; 07265600
END;% 07266000
END;% 07267000
PROCEDURE TABLEOFCONTENTS(B,COUNT);% 07268000
VALUE B,COUNT; REAL B,COUNT;% 07268100
BEGIN REAL I,T,NA,TUSTA,TU,BU; 07269000
$ SET OMIT = NOT(PACKETS) 07269099
REAL FIRST,START,FINAL,PKTCT;% 07269100
$ POP OMIT 07269101
LABEL L,EXIT,G;% 07270000
$ SET OMIT = NOT(SHAREDISK) 07270099
A:=B.[15:15]-1; 07271900
TUSTA:=M[A-1]; 07272000
LOCKCONTROLDECKS; 07272500
A:=FIRSTDECK; 07273000
$ SET OMIT = NOT(PACKETS) 07273099
FIRST~1;% 07273100
$ POP OMIT 07273101
L: I:=SPACE(14) INX TUSTA; 07274000
G: IF A = 0 THEN GO TO EXIT;% 07275000
DISKWAIT(-1,12,A); 07276000
A:=M[I+6].[CF]; 07278000
$ SET OMIT = NOT(DATACOM AND RJE ) 07278499
$ SET OMIT = NOT(SHAREDISK) 07279000
N ~ M[I+2];% 07281000
$ SET OMIT = NOT(PACKETS) 07281099
IF NOT COUNT THEN% 07281100
BEGIN% 07281200
$ POP OMIT 07281201
DISKWAIT(-I-4,9,M[I+10]); 07282000
STREAM(N,T,TU,BU,I); 07284000
BEGIN SI ~ LOC N; SI ~ SI+1;% 07285000
$ SET OMIT = NOT(PACKETS) 07285099
DS:=8 LIT " PACKET ";DS:=5 CHR; 07285100
$ POP OMIT 07285111
$ SET OMIT = PACKETS 07285999
$ SET OMIT = NOT(SHAREDISK) 07286100
$ SET OMIT = SHAREDISK 07286400
DS:=8 LIT" "; 07286500
$ POP OMIT 07286501
$ SET OMIT = NOT(PACKETS) 07286509
DS:=3 LIT " ="; 07286510
$ POP OMIT 07286511
$ SET OMIT = NOT(RJE AND DATACOM ) 07286599
DS:=8 LIT " "; 07286800
NEX: 07286900
$ SET OMIT = PACKETS 07286999
$ SET OMIT = NOT(PACKETS) 07288099
DI:=DI+40;DI:=DI+19;DS:=LIT"~"; 07288100
$ POP OMIT 07288101
END;% 07289000
SPOUT(I);% 07290000
$ SET OMIT = NOT(PACKETS) 07290099
END ELSE% 07290100
BEGIN% OPERATOR WANTS A COUNT 07290200
IF FIRST THEN BEGIN% STORE FIRST DECK #. 07290300
FIRST~0; START~N;% 07290400
END;% 07290500
PKTCT~PKTCT+1; FINAL~N;% 07290600
FORGETSPACE(I);% 07290650
END;% 07290700
$ POP OMIT 07290701
GO TO L;% 07291000
EXIT:IF N=0 THEN 07292000
BEGIN STREAM(I); 07293000
$ SET OMIT = NOT(PACKETS) 07293099
DS:=20 LIT " NO PACKETS ON DISK~"; 07293100
$ POP OMIT 07293101
$ SET OMIT = PACKETS 07293199
SPOUT(I);% 07294000
$ SET OMIT = PACKETS 07294899
$ SET OMIT = NOT(PACKETS) 07294999
END ELSE% CHECK FOR COUNT REQUEST. 07295000
IF COUNT THEN% 07295010
BEGIN;STREAM(C~PKTCT,S~START,% 07295020
F~FINAL,T1~0,T2~0,I);% 07295030
BEGIN DS~LIT " "; T2~DI;% 07295040
SI~LOC C; DI~LOC T1;% 07295050
DS~2 DEC; SI~LOC T1; DI~T2; 07295060
DS~2 CHR; T2~DI; DI~DI-2;% 07295070
DS~FILL; DI~T2;% 07295080
DS~7 LIT " PACKET";% 07295090
SI~LOC T1; %511-07295100
IF SC!"0" THEN GO TO AQ %511-07295102
ELSE SI~SI+I; %511-07295104
IF SC="1" THEN% ONLY 1 DECK %511-07295110
BEGIN DS~2LIT ", ";% 07295120
SI~LOC F; SI~SI+1;% 07295130
DS~5 CHR;% 07295140
END ELSE% MORE THAN 1 07295150
AQ: BEGIN DS~3 LIT "S, "; %511-07295160
SI~LOC S; SI~SI+1;% 07295170
DS~5 CHR;% 07295180
DS~6 LIT " THRU ";% 07295190
SI~SI+4; DS~4 CHR;% 07295200
END;% 07295210
DS~LIT "~"; 07295220
END;% 07295230
SPOUT(I);% 07295235
END ELSE FORGETSPACE(I);% 07295240
$ POP OMIT 07295241
UNLOCKCONTROLKECKS; 07296000
END;% 07297000
PROCEDURE REMOVEDECK(N,TUSTA);VALUE N,TUSTA;REAL N,TUSTA; 07298000
BEGIN REAL I,T,A,L1,J=I,L2,V;% 07299000
$ SET OMIT = NOT(PACKETS) 07299499
REAL L3; 07299500
LABEL FAIL,CONTINUE; 07299600
$ POP OMIT 07299601
LABEL L,EXIT,REMOVE;% 07300000
LOCKCONTROLDECKS; 07301000
IF (I ~ DIRECTORYSEARCH("DECK ",N,5)) = 0 THEN% 07303000
$ SET OMIT = NOT(PACKETS) 07303499
FAIL: 07303500
$ POP OMIT 07303501
BEGIN I ~ SPACE(5);% 07304000
STREAM(N,I);% 07305000
$ SET OMIT = NOT(PACKETS) 07305099
BEGIN DS:=5 LIT " PKT "; 07305100
$ POP OMIT 07305101
$ SET OMIT = PACKETS 07305999
SI ~ LOC N; SI ~ SI+1; DS ~ 5 CHR;% 07307000
DS ~ 13 LIT " NOT ON DISK~";% 07308000
END;% 07309000
GO TO EXIT;% 07310000
END;% 07311000
$ SET OMIT = NOT(SHAREDISK) 07311199
$ SET OMIT = NOT(PACKETS) 07311499
L3:=M[I+6].[FF]; 07311500
$ POP OMIT 07311501
L2:=M[I+6].[CF]; 07312000
IF (A:=FIRSTDECK)=(L1:=I.[FF]) THEN 07313000
BEGIN 07314000
$ SET OMIT = PACKETS 07314099
$ SET OMIT = NOT(PACKETS) 07314109
FIRSTDECK:=IF L3 NEQ 0 THEN L3 ELSE L2; 07314110
IF L2=0 THEN LASTDECK~IF L3 NEQ 0 THEN L3 ELSE 0; 07314120
$ POP OMIT 07314121
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); 07314200
$ SET OMIT = NOT(PACKETS) 07314289
IF L3 NEQ 0 THEN GO TO CONTINUE ELSE 07314290
$ POP OMIT 07314291
GO TO REMOVE; 07314300
END; 07314400
J ~ I.[33:15];% 07315000
L: 07316000
DISKWAIT(-J,30,A); 07317000
IF (V:=M[J+6].[CF])=0 THEN 07318000
$ SET OMIT = NOT(PACKETS) 07318009
IF A=L1 THEN GO REMOVE ELSE BEGIN FORGETSPACE(I); GO FAIL 07318010
END; 07318012
$ POP OMIT 07318013
$ SET OMIT = PACKETS 07318019
IF V ! L1 THEN% 07319000
BEGIN A ~ V; GO TO L END;% 07320000
$ SET OMIT = PACKETS 07320999
$ SET OMIT = NOT(PACKETS) 07321099
M[J+6].[CF]~IF L3!0 THEN L3 ELSE L2; 07321100
$ POP OMIT 07321101
DISKWAIT(J,30,A); 07322000
IF L2 = 0 THEN% 07324000
BEGIN 07325000
$ SET OMIT = PACKETS 07325999
$ SET OMIT = NOT(PACKETS) 07326099
LASTDECK:=IF L3 NEQ 0 THEN L3 ELSE A; 07326100
$ POP OMIT 07326101
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); 07327000
$ SET OMIT = PACKETS 07327999
$ SET OMIT = NOT(PACKETS) 07329999
END ELSE IF L3=0 THEN ELSE 07330000
CONTINUE: 07330050
BEGIN J~I INX 0; 07330100
DISKWAIT(-J,30,L3); 07330200
M[J+6].[CF]~L2; 07330300
DISKWAIT(J,30,L3); 07330400
END; 07330500
$ POP OMIT 07330501
REMOVE: 07331000
FORGETSPACE(I); 07332000
I:=DIRECTORYSEARCH("DECK ",N,8).[CF]; 07333000
T ~ M[I+9];% 07343000
FOR V ~ 1 STEP 1 UNTIL T DO% 07344000
IF M[I+V+9]!0 THEN FORGETUSREDISK(M[I+V+9],M[I+8]); 07345000
STREAM(N,I);% 07346000
$ SET OMIT = NOT(PACKETS) 07346099
BEGIN DS:=5 LIT " PKT "; 07346100
$ POP OMIT 07346101
$ SET OMIT = PACKETS 07346999
SI ~ LOC N; SI ~ SI+1; DS ~ 5 CHR;% 07348000
DS ~ 9 LIT " REMOVED~";% 07349000
END;% 07350000
$ SET OMIT = PACKETS 07350099
EXIT: SPOUTER(I&TUSTA[9:9:9],TUSTA,LIBMSG) 07351000
$ SET OMIT = PACKETS 07351099
;UNLOCKCONTROLDECKS; 07352000
END;% 07353000
PROCEDURE DECKREMOVER(B); BALUE B; REAL B;% 07354000
BEGIN REAL K,N,F;% 07355000
INTEGER U; LABEL ON,ERR; 07355100
REAL D; 07355200
LABEL L,TRYIT,GIVEUP; 07356000
K ~ B.[15:15]-1;% 07357000
L: STREAM(X~12,B:A~0);% 07358000
BEGIN SI ~ B;% 07359000
U: IF SC = " " THEN BEGIN SI~SI+1; GO TO U END;% 07360000
IF SC="=" THEN BEGIN DI~LOC X; DI~DI+6; DS~CHR; 07360100
SI~SI-1; B~SI; GO TO E END;07360200
IF SC = "#" THEN SI:=SI+1; 07361000
BL: IF SC=" " THEN BEGIN SI:=SI+1;GO TO BL; END; 07361500
DI:=LOC X; DI:=DI+1; DS:=5 LIT "#0000"; 07362000
4(IF SC < "0" THEN JUMP OUT TO EN; 07363000
IF SC > "9" THEN JUMP OUT TO EN; 07364000
SI:=SI+1; TALLY:=TALLY+1); 07365000
EN: A:=TALLY; SI:=SI-A; DI:=DI-A; DS:=A CHR; 07365500
N: IF SC = " " THEN BEGIN SI~SI+1; GO TO N END;% 07366000
DS ~ CHR; B ~ SI;% 07367000
E: END;% 07368000
P(.B,~,.N,~);% 07369000
F~N.[36:6]; N.[36:6]~"~"; 07370000
IF F="~" OR F="," OR F="=" THEN 07371000
BEGIN IF F="=" THEN 07371100
BEGIN IF D=0 THEN D~SPACE(30); 07371200
LOCKCONTROLDECKS; 07371300
IF (N:=FIRSTDECK)=0 THEN 07371400
GIVEUP: 07371450
BEGIN F:="~"; 07371500
UNLOCKCONTROLDECKS; 07371600
GO ON; 07371700
END; 07371750
TRYIT: DISKWAIT(-D,30,N); 07371800
$ SET OMIT = NOT(SHAREDISK) 07371809
N:=M[D+2]; 07371900
UNLOCKCONTROLDECKS; 07371950
END; 07372000
FOR U ~ 0 STEP 1 UNTIL PSEUDOMAX DO 07372090
IF CIDROW[U]!0 THEN 07372100
IF(CIDTABLE[U,2] EQV N)=NOT 0 THEN 07372200
IF LABELTABLE[U+32]}0 07372300
$ SET OMIT = NOT(PACKETS) 07372309
AND LABELTABLE[U+32]!@214 AND 07372310
PACKETACT[U]=0 07372320
$ POP OMIT 07372321
THEN 07372330
BEGIN 07372400
ENDOFDECK(U,M[K-1]); 07372500
GO ON; 07372600
END ELSE GO TO ERR; 07372700
REMOVEDECK(N,M[K-1]); 07372800
ON: IF F!"~" THEN GO TO L; 07372900
FORGETSPACE(K);% 07373000
END ELSE 07374000
ERR: SPOUT(K INX M[K-1]); 07374100
IF D!0 THEN FORGETSPACE(D); 07374200
END;% 07375000
BOOLEAN PROCEDURE READEMFROMDISK(H,IB);% 07376000
VALUE H,IB; ARRAY H[*],IB[*];% 07377000
BEGIN% 07378000
% H[0] = ADDRESS OF BU+1 (B)% 07379000
% H[1] = ADDRESS OF B2+1% 07380000
% H[2] = DECK NAME% 07381000
% H[3] = RECORDCOUNT (N)% 07382000
% H[4] = NEXT CONTROL CARD (L)% 07383000
% H[5] = RECORDS USED IN THIS BLOCK | 10 (R)% 07384000
% H[7] - H[30] ARE FILE HEADER% 07385000
REAL A,B;% 07386000
DEFINE N=H[3]#,L=H[4]#,R=H[5]#;% 07387000
INTEGER I=A; DEFINE MOM=CIDROW[M[B]]#; 07388000
$ SET OMIT = NOT(BREAKOUT) 07388010
B ~ H[0];% 07389000
IF R = 0 THEN% 07390000
IF (M[B-2] AND IOMASK) = 0 THEN% 07391000
SLEEP([M[B-2]],IOMASK);% 07392000
STREAM(B!B+R,IB);% 07393000
BEGIN SI ~ B; DS ~ 10 WDS END;% 07394000
M[IB INX NOT 0] ~ 10; 07394500
IF (READEMFROMDISK ~ N=L) THEN% 07395000
L ~ IB[9];% 07396000
IF (A:=N:=*P(DUP)+1) > (H[7]+1) THEN %639-07397000
BEGIN READEMFROMDISK:=1; 07398000
STREAM(IB); 07398100
BEGIN 07398200
$ SET OMIT = NOT(PACKETS) 07398299
DS:=8LIT" "; SI:=IB; DS:=8 WDS; DI:=IB; 07398300
$ POP OMIT 07398301
DS:=5LIT"-END."; DI:=DI-5; DS:=RESET; 07398400
END; 07398500
END 07398600
ELSE BEGN IF (R ~ *P(DUP)+10) = 30 THEN% 07399000
BEGIN IB ~ [M[B-2]];% 07400000
R ~ 0; 07400400
A ~ A DIV 3+1; 07400500
I~H[A DIV H[8]+10]+A MOD H[8]; 07401000
IF I>0 THEN % NEXT BUFF EXISTS %639-07401900
DISKIO(IB,1-B,30,I);% 07402000
H[0] ~ H[1];% 07403000
H[1] ~ B;% 07404000
END; END; END;% 07405000
BOOLEAN PROCEDURE PRINTORPUNCHWAIT(Q,PNCH);VALUE Q,PNCH;REAL Q,PNCH; 07405100
FORWARD; 07405110
PROCEDURE ENDOFDECK(R,TUSTA);VALUE R,TUSTA; REAL R,TUSTA; 07406000
BEGIN ARRAY H[*];% 07407000
REAL B,I;% 07408000
$ SET OMIT = NOT(PACKETS) 07408099
REAL DISKAD,PBREC,T,USERIO; % %750-07408100
$ POP OMIT 07408101
LABEL EXIT; 07408500
IF (H:=CIDROW[R])=0 THEN GO TO EXIT; 07409000
LABELTABLE[R+32] ~ @114; 07409100
MULTITABLE[R+32] ~ RDCTABLE[R+32] ~ 0; 07409200
USERID~UNITCODE[R+29]; % %750-07409250
UNITCODE[R+9]:=-0; 07409300
IF NOT TUSTA.[1:1] THEN REMOVEDECK(H[2],ABS(TUSTA)) ELSE 07410000
P(DIRECTORYSEARCH(-"DECK ",H[2],14),DEL);07410100
FOR I ~ 0 STEP 1 UNTIL 1 DO% 07411000
BEGIN B ~ H[I];% 07412000
IF (M[B-2] AND IOMASK) = 0 THEN 07413000
SLEEP([M[B-2]],IOMASK);% 07414000
END;% 07415000
IF CIDROW[R]=0 THEN GO TO EXIT; % FIXES TIMING PROB. 07415100
IF H.[18:15] ! 0 THEN 07416000
FORGETSPACE(H.[18:15]-2); 07417000
$ SET OMIT = NOT(PACKETS) 07417099
IF PACKETPBD[R] GEQ 11 THEN 07417100
BEGIN 07417200
PBCOUNT := PBCOUNT+1; 07417300
I := 001 & CIDTABLE[R,6][6:6:24]; 07417400
IF (PBREC := DIRECTORYSEARCH("PBD ",I,5))!0 THEN 07417500
BEGIN 07417600
IF PACKETPAGE[R]>1 THEN 07417700
BEGIN 07417800
PBREC := PBREC.[CF]; 07417900
T := M[PBREC+6]; 07418000
DISKAD := M[PBREC+10]+2; 07418100
DISKWAIT(-PBREC,30,DISKAD); 07418200
IF (M[PBREC+12] EQV (-"ABORTED"))=NOT 0 THEN 07418300
STREAM(B:=PBREC+11); 07418500
BEGIN 07418600
DS:=8LIT":|0|4000"; DS:=8LIT"0PACKET "; 07418700
END; 07418800
M[PBREC+15]~M[PBREC+27]~USERID; % %750-07418850
DISKWAIT(PBREC,30,DISKAD); 07418900
END; 07419000
P(DIRECTORYSEARCH(-"PBD ",1,14),DEL); 07419100
IF AUTOPRINT OR T0 THEN 07419200
P(PRINTORPUNCHWAIT(I,0&T[9:39:9[),DEL); 07419300
FORGETSPACE(PBREC); 07419400
END; 07419500
END; 07419600
PSEUDO[R] := 07419700
$ POP OMIT 07419701
CIDROW[R] := 0; 07419800
IF(RUNUMBER~RUNUMBER+1)>0 THEN 07420000
STARTADECK(IF TUSTA.[1:1] THEN -H[2] ELSE 0); 07420010
FORGETSPACE(H); 07420050
EXIT: 07420100
END;% 07421000
% PSEUDOCOPY DECLARATION MOVED TO 02347110 TO %541-07421500
% ALLOW ACCESS IN DRANO %541-07421505
PROCEDURE STARTADECK(N); VALUE N; REAL N; 07422000
BEGIN LABEL EXIT,L,POSSIBLE,NEXT;% 07423000
REAL I,R,T,A,S; 07424000
READ SDED; 07424100
ARRAY H[*];% 07425000
LABEL AGAIN,START; 07425500
START: 07425600
IF N.[1:1] THEN BEGN SDED~ABS(N); N~0 END; 07425700
LOCKCONTROLDECKS; 07426000
IF RUNUMBER LEQ 0 AND N=0 THEN GO TO EXIT; 07426100
AGAIN: 07427500
IF PSEUDOCOPY > 2 THEN% TOO MANY COPIES CONTROLCARD 07427600
IF STARTOG AND N=0 THEN GO TO EXIT % 07427610
ELSE BEGIN STARTOG ~ TRUE; 07427620
UNLOCKCONTROLDECKS; 07427625
COMPLEXSLEEP(PSEUDOCOPY { 2);% 07427630
STARTOG ~ FALSE;% 07427640
GO TO START;% 07427645
END;% 07427650
FOR R ~ 0 STEP 1 UNTIL PSEUDOMAX DO 07428000
IF CIDROW[R] = 0 THEN GO TO POSSIBLE;% 07429000
STREAM(S~S~SPACE(4)); 07429100
DS:=27 LIT" ALL PSEUDO-READERS IN USE~"; 07429200
SPOUT(S); 07429300
GO TO EXIT;% 07430000
POSSIBLE:% 07431000
IF (A:=FIRSTDECK)=0 THEN GO TO EXIT; 07432000
LABELTABLE[R+32]:=@114; 07432100
W~CIDROW[R]~[M[S~GETSPACE(94,20,1)+2]]&94[8:38:10]; 07433000
M[S-2].[9:6] ~ 0; H[2] ~ 0;% 07434000
L: DISKWAIT(-S,30,A); 07435000
IF N!0 THEN 07436000
BEGIN 07436100
IF H[2].[12:24]~N THEN GO TO NEXT; 07436200
IF H[4].[2:1] THEN 07436300
BEGIN 07436400
STREAM(A:=[H[2]], 07436500
$ SET OMIT = NOT(SHAREDISK) 07436509
S); 07436520
$ SET OMIT = PACKETS 07436599
$ SET OMIT = NOT(PACKETS) 07436609
BEGIN SI:=A;SI:=SI+1;DS:=5 LIT" PKT "; 07436610
$ POP OMIT 07436611
SI:=5 CHR;DS:=7LIT" IN USE"; 07436700
$ SET OMIT = NOT(SHAREDISK) 07436799
DS:=LIT"~"; 07437000
END; 07437100
SPOUT(S); 07437200
CIDROW[R]:=0; 07437300
GO TO EXIT; 07437400
END; 07437500
END ELSE 07437600
IF H[4].[2:1] OR (SDED!0 AND H[2]=SDED) 07437800
$ SET OMIT = NOT(SHAREDISK) 07437899
THEN GO TO NEXT; 07438000
H[4]:=(*P(DUP))&2[2:46:2]&SYSNO[4:46:2]; 07438100
DISKWAIT(S,30,A); 07438200
$ SET OMIT = NOT (DATACOM AND RJE) 07438250
H[0] ~ S+32;% 07441000
H[1] ~ S+64;% 07442000
T ~ [H[30]]; DISKIO(T,1-H[0],30,H[10]);% 07444000
IF H[7] LSS 3 THEN H[62]:=IOMASK ELSE 07445000
BEGIN T:=[H[62]]; IF H[8]=1 THEN 07445100
DISKIO(T,1-H[1],30,H[11]) ELSE 07445200
DISKIO(T,1-H[1],30,H[10]+1); 07445300
END; 07445400
T:=GTSPACE(13,20,0)+4; 07446000
$ SET OMIT = NOT(BREAKOUT) 07446010
M[T INX 10] := H[5]; 07446100
$ SET OMIT = NOT(PACKETS) 07446149
T.[24:6]+H[6].[2:6]; 07446150
$ POP OMIT 07446151
H[3] := H[4] := H[5] := H[6] := 0; 07446200
M[T-4].[9:6] ~ 0;% 07447000
LABELTABLE[R+32]~-@14; %LET IT BE MOVED 07448000
I~READEMFROMDISK(H,[M[T]]&10[8:38:10]); 07448500
INDEPENDENTRUNNER(P(.CONTROLCARD),T& 07449000
$ SET OMIT = NOT(DATACOM AND RJE ) 07449099
(R+32)[2:42:6],192); 07449200
PSEUDOCOPY ~ PSEUDOCOPY + 1;% 07449500
IF (RUNUMBER~RUNUMBER-1) LEQ 0 OR N!0 THEN GO TO EXIT; 07450000
GO TO AGAIN; 07450200
NEXT:IF (A:=H[6].[CF])!0 THEN GO TO L; 07451000
IF N!0 THEN 07452000
BEGIN 07452100
STREAM(N,S); 07452200
$ SET OMIT = PACKETS 07452299
$ SET OMIT = NOT(PACKETS) 07452309
BEGIN SI~LOC N; SI~SI+4; DS:=6 LIT" PKT #"; 07452310
$ POP OMIT 07452311
DS:=4 CHR;DS:=13 LIT" NOT ON DISK~"); 07452400
END; 07452500
SPOUT(S); 07452600
END ELSE FORGETSPACE(S); 07452700
CIDROW[R] ~ 0;% 07453000
EXIT: UNLOCKCONTROLDECKS; 07455000
END;% 07456000
PROCEDURE RUNTHEDECK(B);VALUE B; REAL B;% 07457000
BEGIN REAL I,J;% 07458000
STREAM(S:=0:B,A:=[I]); 07461000
BEGIN SI ~ B;% TO REAL IN I 07461100
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 07461120
IF SC="#" THEN 07461140
BEGIN 07461160
L1: SI:=SI+1; IF SC=" " THEN GO TO L1; 07461180
DS:=8 LIT"00000000"; 07461200
4(IF SC<"0" THEN JUMP OUT; 07461220
IF SC>"9" THEN JUMP OUT; 07461240
SI:=SI+1; TALLY:=TALLY+1); 07461260
S:=TALLY; SI:=SI-S; DI:=DI-S; DS:=S CHR; 07461280
TALLY:=1; 07461300
GO TO FX; 07461320
DS:=4 LIT"0000";DS:=4 CHR;TALLY:=1;GO TO EX; 07461330
END; 07461340
SI ~ SI + 1;% 07461400
IF SC { "9" THEN IF SC } "0" THEN GO TO TWO; 07461500
SI ~ SI - 1; DS ~ OCT;% 07461510
GO TO EX; 07461520
TWO: SI ~ SI - 1; DS ~ 2 OCT; 07461530
EX:S:=TALLY; 07461540
END; 07461550
J:=P; 07461560
B:=B.[15:15]-1; 07461570
IF J THEN 07461600
BEGIN 07461700
FORGETSPACE(B); 07461800
STARTADECK(I); 07461900
END ELSE 07462000
BEGIN 07462100
IF I GTR PSEUDOMAX1 THEN I:=NABS(RUNUMBER) ELSE 07462200
BEGIN 07462250
RUNUMBER:=I; 07462300
FOR J:=0 STEP 1 UNTIL PSEUDOMAX DO 07462400
RUNUMBER:=RUNUMBER-(CIDROW[J]!0); 07462500
END; 07462600
STREAM(X1:=1-I.[1:1],K2:=RUNUMBER.[1:1],I:=ABS(I),B);07463000
BEGIN CI:=CI+X1; GO L1; DS:=10LIT" WILL USE ";GO L2; 07464000
L1: CI:=CI+X2; GO L2; DS:=LIT"-"; L2: 07464100
SI:=LOC I;DS:=2 DEC; 07465000
DS ~ 13 LIT " PSEUDO-RDRS~"; 07466000
END;% 07467000
SPOUT(B INX M[B-1]); 07468100
IF RUNUMBER GTR 0 THEN STARTADECK(0); 07469000
END; 07472500
END;% 07473000
PROCEDURE EXTERNALEND(B); VALUE B; REAL B; 07473100
BEGIN REAL U; LABEL EXIT; 07474000
U ~ UNITIN(TINU,B); 07475000
B ~ B.[15:15]-1; 07476000
IF 32 { U AND U { PSEUDOMAXT THEN 07477000
IF LABELTABLE[U] } 0 THEN 07478000
$ SET OMIT = NOT(PACKETS) 07478099
IF LABELTABLE[U] NEQ @214 AND PACKETACT[U=32]=0 THEN 07478100
$ POP OMIT 07478101
IF CIDROW[U-32] ! 0 THEN 07478500
BEGIN 07479000
ENDOFDECK[U-32],M[B-1]); 07479100
FORGETSPACE(B); 07480000
GO TO EXIT; 07481000
END; 07482000
SPOUT(B INX M[B-1]); 07483000
EXIT:END; 07484000
PROCEDURE CHANGEPRIORITY(BUFF,MIX); VALUE BUFF,MIX; REAL BUFF,MIX; 07485000
BEGIN INTEGER PRIORITY; REAL B; 07486000
$ SET OMIT = NOT(PACKETS) 07486499
DEFINE UNITNO = PSEUDOMIX[MIX]#; 07486500
$ POP OMIT 07486501
BUFF ~ ((B~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 07487000
STREAM(PRIORITY:B); 07488000
BEGIN SI~B; 07489000
N: IF SC="~" THEN GO TO X; 07490000
IF SC<"0" THEN BEGIN SI~SI+1; GO TO N; END; B~SI; 07491000
K: IF SC}"0" THEN IF SC{"9" THEN 07492000
BEGIN TALLY~TALLY+1; SI~SI+1; GO TO K END; 07493000
SI~B; DI~LOC PRIORITY; B~TALLY; DS~B OCT; GO TO Z; 07494000
X: DI~LOC PRIORITY; SKIP DB; DS~11 SET; 07495000
Z: 07496000
END STREAM; 07497000
IF (PRIORITY~P) } 0 THEN 07498000
IF PRYOR[MIX]}0 THEN% 07501000
IF JAR[MIX,*]~0 THEN 07502000
BEGIN JAR[MIX,2].[CF]~ PRYOR[MIX]~ P(PRIORITY~ 07503000
IF PRIORITY}32766 THEN 32766 ELSE PRIORITY, DUP) & P[CTF]; 07503500
STREAM(J~JAR[MIX,*],MIX,PRIORITY,BUFF); 07504000
BEGIN DS~10 LIT " PRIORITY="; 07505000
SI~LOC PRIORITY; BUFF~DI; DS~6 DEC; DI~DI-6; 07506000
DS~5 FILL; DI~BUFF; DI~DI+6; DS~LIT":"; 07507000
SI~J; SI~SI+1; DS~7 CHR; SI~SI+1; DS~LIT"/"; DS~7 CHR;07508000
DS~LIT"="; SI~LOC MIX; DS~2DEC; DS~LIT"~"; 07509000
DI~DI-3; DS~FILL; 07509500
END END; 07510000
SPOUTER(BUFF,UNITNO,1); 07511000
END CHANGEPRIORITY; 07512000
PROCEDURE ENTERCONTROLDECK(H); VALUE H; ARRAY H[*]; 07541000
BEGIN REAL R,S,T,T1,T2; 07542000
INTEGER I; 07543000
$ SET OMIT = NOT(PACKETS) 07543099
LABEL MORE; 07543100
$ POP OMIT 07543101
T~"DECK "&H[4][1:47:1]; % FOR SCRATCHDIR DELETE 07545000
S:=NEXTCDNUM(0); 07547000
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); % CHANGE LASTCDNUM ON DISK07547100
$ SET OMIT = NOT(PACKETS) 07547499
MORE: 07547500
$ POP OMIT 07547501
H[0]:=@001200036000301; 07548000
$ SET OMIT = NOT(PACKETS) 07548099
T2~H[6].[FF]; H[6].[FF]~T; 07548100
$ POP OMIT 07548101
STREAM(DATE,B~[H[3]]); 07549000
BEGIN SI~LOC DATE;DS~8 OCT;DI~DI-8;DS~2 LIT"+7";END; 07549100
H[4] := 0& 07550000
$ SET OMIT = NOT SHAREDISK 07550003
15[12:44:4]; 07550010
H[1]~(XCLOCK+P(RTR))&H[3][6:30:18]; 07550100
H[2]:=S:=@14&@12[6:42:6]&S[12:24:24]&@37[36:42:6]; 07557000
T1:=EUF(T,S,H.[CF]-1); 07559000
$ SET OMIT = NOT(PACKETS) 07559099
IF T2 NEQ 0 THEN 07559100
BEGIN DISKWAIT(-(H INX 0), 30, T2); 07559110
FORGETSPACE(T2); 07559120
S~H[2]; GO TO MORE; 07559180
END; 07559190
$ POP OMIT 07559191
H[2]~LASTCDNUM; 07559500
IF FIRSTDECK=0 THEN FIRSTDECK:=T1 ELSE 07560000
BEGIN 07561000
$ SET OMIT = SHAREDISK 07561990
LOCKDIRECTORY; 07562000
$ POP OMIT 07562010
DISKWAIT(-(I:=SPACE(30)),-30,LASTDECK); 07564000
M[I+6].[CF]:=T1; 07565000
DISKWAIT(I,-30,LASTDECK); 07566000
FORGETSPACE(I); 07567000
$ SET OMIT = SHAREDISK 07567990
UNLOCKDIRECTORY; 07568000
$ POP OMIT 07568010
END; 07569000
LASTDECK:=T1; 07570000
DISKWAIT(KLUMP,-3,DIRECTORYTOP+3); 07571000
UNLOCKTOG(CDMASK); 07572000
IF RUNUMBER GTR 0 THEN STARTADECK(0); 07573000
END ENTERCONTROLDECK; 07575000
BOOLEAN PROCEDURE MTXIN(I,U,BUFF);% 08000000
REAL U,BUFF; INTEGER I;% 08001000
BEGIN LABEL EXIT,X;% 08002000
U ~ UNITIN(TINU,BUFF); 08003000
BUFF ~ BUFF.[15:15]-1; 08004000
IF U > 15 THEN% 08005000
BEGIN;STREAM(BUFF); DS ~ 8 LIT "INV KBD ";% 08006000
GO TO EXIT;% 08007000
END ELSE I ~ TWO(U); 08008000
STREAM(A~TINU[U];BUFF);% 08009000
BEGIN SI~LOC A; SI~SI+5; DS~LIB" "; DS~3 CHR;% 08010000
DS ~ LIT " "; A ~ DI;% 08011000
END;% 08012000
P([BUFF].~);% 08013000
IF LABELTABLE[U] = @114 OR LABELTABLE[U] = @214 THEN% 08014000
BEGIN 08015000
STREAM(SAV:=((I AND SAVEWORD) NEQ 0), BUFF); 08015100
BEGIN 08015200
DS:=10LIT"NOT READY~"; 08015300
SAV(DI:=DI-1; DS:=8LIT"*SAVED)~"); 08015400
END; 08015500
GO TO EXIT; 08016000
END;% 08017000
IF LABELTABLE[U] < 0 THEN% 08018000
BEGIN;STREAM(BUFF); DS ~ 7 LIT "IN USE~";% 08019000
END% 08020000
ELSE GO TO X;% 08021000
EXIT:MTXIN ~ TRUE;% 08022000
X:END;% 08023000
PROCEDURE TAPEPURGE(BUFF); VALUE BUFF; REAL BUFF;% 08024000
BEGIN LABEL EXIT;% 08025000
REAL I,U;% 08026000
REAL R,T; 08027000
BOOLEAN TEST; 08027100
REAL WHAT = BUFF;% 08028000
IF MTXIN(I,U,WHAT) THEN GO TO EXIT;% 08029000
STREAM(B:=BUFF,T~[T]); 08029015
BEGIN SI:=B; SI:=SI+6; 08029020
IF SC="-" THEN 08029025
BEGIN SI:=SI+1; 08029030
5(IF SC="~" THEN JUMP OUT; 08029035
TALLY:=TALLY+1;SI:=SI+1); 08029040
B:=TALLY; SI:=SI-B; DS:=B OCT; 08029045
DI~DI-8; DS:=LIT "+"; %725-08029046
END; 08029050
END; 08029055
LABELTABLE[U] ~ -@14; 08029100
IF (R~WAITIO(@500000000,@177,U))!0 THEN 08030000
IF R!@120 THEN %ERROR OTHER THAN WRITE LOCK 08030100
BEGIN;STREAM(U~TINU[U],BUFF); 08030200
BEGIN DS~14 LIT "#CANNOT PURGE "; 08030300
SI~LOC U; SI~SI+5; DS~3CHR; 08030310
DS~LIT"~"; 08030320
END; 08030330
LABELTABLE[U]~@214; 08030400
GO TO EXIT; 08030500
END ELSE %NO WRITE RING 08030600
BEGIN; STREAM(BUFF); DS ~ 11 LIT "WRITE LOCK.";% 08031000
LABELTABLE[U] ~ @114; 08031100
GO TO EXIT;% 08032000
END;% 08033000
IF NOT T.[1:1] THEN IF T=0 THEN %725-08033980
BEGIN T:=PRNTABLE[U].[30:18]; TEST:= TRUE END; 08033990
IF I.[1:1]=0 AND T=0 THEN BEGIN %725-08033992
STREAM(BUFF); DS~17 LIT "NOT PG-ED(PRN=0)~"; %725-08033993
LABELTABLE[U]~ @14; GO EXIT END; T~ABS(T); %725-08033994
STREAM(A:=T,BUFF); 08034000
BEGIN DI ~ DI + 3; DS ~ 8 LIT " LABEL "; 08035000
8(DS~2 LIT "0X"); 08035100
24(DS~2 LIT "0"); DS~2 LIT "}!"; 08036000
DI ~ DI-21; SI ~ LOC A; DS ~ 5 DEC;% 08037000
END;% 08038000
RRRMECH ~ I OR RRRMECH;% 08039000
MULTITABLE[U] ~ 0;% 08041000
P(WAITIO(@4200000000,0,U),DEL);% 08042000
R ~ WAITIO(BUFF INX @120500000001,@2000000,U) OR% 08043000
WAITIO(BUFF INX 10,@2000000,U);% 08044000
IF MOD3IOS THEN %AI08044500
DO UNTIL P(WAITIO(BUFF INX @340000012,@50,U))=@10 %AI08044600
ELSE %AI08044700
P(WAITIO(@4200000000,0,U),DEL);% 08045000
SLEEP([TOGLE],STATUSMASK); 08046000
RRRMECH ~ RRRMECH AND NOT I;% 08047000
READY ~ READY AND NOT I;% 08048000
IF R = 0 THEN BEGIN% 08049000
LABELTABLE[U] ~ @114;% 08050000
IF TEST THEN BEGIN STREAM(B~T,BUFF); %708-08051000
BEGIN DS~10 LIT"PG-ED(PRN="; SI~LOC B; DS~5 DEC; DS~2 LIT")~";%708-08051004
END; END % PRINT PRN WITH PLAIN PGMT %708-08051005
ELSE BEGIN STREAM(A:=T,B:=PRNTABLE[U],[30:18],BUFF); 08051010
BEGIN DS:=10LIT"PG-ED(PRN="; 08051020
SI:=LOC A; DS:=5 DEC; 08051030
DS:=5LIT",WAS "; 08051040
SI:=LOC B; DS:=5 DEC;DS:=2LIT")~"; 08051050
END; 08051060
PRNTABLE[U].[30:18] ~ T; 08051065
END; 08051070
EXIT: SPOUT(NABS(BUFF INX M[BUFF-1]));% 08052000
END ELSE BEGIN% 08053000
LABELTABLE[U] ~ @214;% 08054000
FORGETSPACE(BUFF);% 08055000
END;% 08056000
END;% 08057000
PROCEDURE GIMEDATE(B,DT); VALUE B,DT; REAL B,DT; FORWARD; 08070000
PROCEDURE REWINDANDLOCK(WHAT); VALUE WHAT; REAL WHAT;% 08079000
BEGIN REAL BUFF=WHAT,U;% 08080000
INTEGER I;% 08081000
LABEL EXIT;% 08082000
IF MIXIN(I,U,BUFF) THEN GO TO EXIT;% 08083000
RRRMECH ! RRRMECH OR I;% 08084000
LABELTABLE[U] ~ -@14;% 08085000
MULTITABLE[U] ~ 0;% 08086000
P(WAITIO(@4200000000,0,U),DEL);% 08087000
SLEEP([TOGLE],STATUSMASK); 08088000
RRRMECH ~ RRRMECH AND NOT I;% 08089000
READY ~ READY AND NOT I;% 08090000
LABELTABLE[U] ~ @214;% 08091000
STREAM(BUFF); DS ~ 5 LIT "RW/L~";% 08092000
EXIT: SPOUT(BUFF INX M[BUFF-1]); 08093000
END;% 08094000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08095050
%**********************************************************************%08095100
%* *%08095150
%* P R I N T D I R E C T O R Y *%08095200
%* - - - - - - - - - - - - - - *%08095250
%* *%08095300
%* PURPOSE: THIS PROCEDURE HANDLES THE PD, EX, LF, LC AND LS *%08095350
%* MESSAGES. ALL MESSAGES ARE FORMS OF THE PD MESSAGE *%08095400
%* EXCEPT FOR CERTAIN DIFFERENCES. THE PD MESSAGE WILL *%08095450
%* LIST THE NAMES OF THE DESIRED FILES AS WELL AS *%08095500
%* CERTAIN PIECES OF INFORMATION IF REQUESTED. *%08095550
%* *%08095600
%* SYNTAX: THE FORMAT OF ALL THE KEYIN MESSAGES WITH THE *%08095650
%* EXCEPTION OF THE LF MESSAGE IS AS FOLLOWS: *%08095700
%* *%08095750
%* <MESSAGE> <FILE SPECIFIER> <OPTION-LIST> *%08095800
%* *%08095850
%* <MESSAGE> ::= PD / EX / LC / LS *%08095900
%* *%08095950
%* <FILE SPECIFIER> ::= <FILENAME> / <FILENAME> "/" *%08096000
%* <FILENAME> *%08096050
%* *%08096100
%* <OPTION-LIST> ::= <EMPTY> / <OPTION> / <OPTION> , *%08096150
%* <OPTION-LIST> *%08096200
%* *%08096250
%* <OPTION> ::= RECS / LAST / DATE / SAVE / SIZE / *%08096300
%* CREATOR / SECURITY / ALL *%08096350
%* *%08096400
%* <FILENAME> ::= [FROM 1 TO 7 CHARACTERS OPTIONALLY *%08096450
%* ENCLOSED IN QUOTES] / = *%08096500
%* *%08096550
%* THE SYNTAX FOR THE LF MESSAGE IS: *%08096600
%* *%08096650
%* LF <USERID> <OPTION-LIST> *%08096700
%* *%08096750
%* SEMANTICS: THE EX, LF, LC, AND LS MESSAGES ARE JUST *%08096800
%* MODIFIED FORMS OF THE PD MESSAGE. THE EX MESSAGE IS *%08096850
%* THE SAME AS A PD EXCEPT THAT ONLY THE EXPIRED FILES *%08096900
%* ARE LISTED. THE LF IS THE SAME AS A PD=/= EXCEPT *%08096950
%* THAT ONLY THE FILES BELONGING TO THE SPECIFIED USER *%08097000
%* ARE LISTED. THE LC MESSAGE IS THE SAME AS A "PD *%08097050
%* <FILE SPECIFIER> CREATOR". THE LS MESSAGE IS THE *%08097100
%* SAME AS "PD <FILE SPECIFIER> SECURITY,CREATOR". *%08097150
%* *%08097200
%* THE OPTIONS SPECIFY WHAT ADDITIONAL INFORMATION *%08097250
%* IS TO BE LISTED BESIDES THE DEFAULT INFORMATION, IF *%08097300
%* AN UNRECOGNIZABLE WORD IS ENCOUNTERED IN THE OPTION *%08097350
%* LIST, IT IS IGNORED. THE AVAILABLE OPTIONS ARE: *%08097400
%* *%08097450
%* RECS - NUMBER OF RECORDS IN THE FILE, (SPECIAL LOGIC *%08097500
%* IS INCORPORATED TO THE LIST THE CORRECT NUMBER *%08097550
%* FOR BACKUP FILES). *%08097600
%* *%08097650
%* LAST - LAST ACCESS DATE. *%08097700
%* *%08097750
%* DATE - CREATION DATE. *%08097800
%* *%08097850
%* SAVE - SAVE FACTOR. *%08097900
%* *%08097950
%* SIZE - SIZE OF THE FILE IN SEGMENTS. *%08098000
%* *%08098050
%* CREATOR - PRIVILEGED USERCODE ASSOCIATED WITH FILE. *%08098100
%* (FOR BACKUP FILES THE LABEL OF THE PRINT FILE *%08098150
%* AND THE NAME OF THE PROGRAM CREATING THE BACKUP *%08098200
%* IS ALSO LISTED). *%08098250
%* *%08098300
%* SECURITY - ACCESS PRIVILEGES OF THE FILE, I.E., *%08098350
%* LOCKED, UNLOCKED, PUBLIC, PRIVATE, FREE. *%08098400
%* *%08098450
%**********************************************************************%08098500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08098550
PROCEDURE PRINTDIRECTORY(BUFF,CODE); %152-08098600
VALUE BUFF,CODE; %152-08098650
REAL BUFF, %152-08098700
BEGIN %152-08098750
%152-08098800
INTEGER %152-08098850
I, % NORMALLY CONTAINS OPTION NUMBER. %152-08098900
J; % JUNK. %152-08098950
%152-08099250
REAL %152-08099300
MFID, % MFID OF DESIRED FILE OR -1 IF "=". %152-08099350
FID, % FID OF DESIRED FILE OR -1 IF "=". %152-08099400
C, % ADDRESS OF DISK HEADER. %152-08099450
D, % MFID OF LAST FILE FOUND BY SEEKNAM. %152-08099500
E, % FID OF LAST FILE FOUND BY SEEKNAM. %152-08099550
N, % WORK VARIABLE USED BY SEEKNAM TO SAVE INFO. %152-08099600
T, % NORMALLY USED TO SAVE DEST. INDEX. %152-08099650
INFO, % BIT MASK FOR OPTIONS SELECTED. %152-08099700
LABELREC, % ADDRESS OF LABEL RECORD FOR PDB ( IF LC ). %152-08099750
STA, % ORIGINATING STATION. TU/BUFF IN [9:9] FIELD. %152-08099775
USERID, % USERID IF LF. %152-08099800
X; % JUNK. %152-08099850
%152-08099900
ARRAY %152-08099950
HDR[*], % DESCRIPTOR TO DISK HEADER. %152-08100000
XLST[*];% SOME DAY WE MAY ALLOW EXCEPTION LIST. %152-08100050
%152-08100100
BOOLEAN %152-08100150
PBDTOG, % TRUE IF SELECTED FILE IS A PBD. %152-08100200
FOUNDAFILE; % TRUE IF WE LISTED OUT AT LEAST ONE FILE. %152-08100250
%152-08100300
LABEL EXIT,DROPOUT,DUMMY,OPTIONS; %152-08100350
DEFINE NUMOPTS = 7#; %152-08100500
DEFINE %152-08100510
TUANDBUF = [9:9]%, % TU/BUFF STORED IN [9:9] FIELD. %152-08100520
STATUANDBUF = STA.TUANDBUF#; % TU/BUFF OF ORIGINATING STATION. %152-08100530
DEFINE PD = (CODE = 0)#, %152-08100550
EX = (CODE = 1)#, %152-08100600
LC = (CODE = 2)#, %152-08100650
LF = (CODE = 3)#, %152-08100700
LS = (CODE = 4)#; %152-08100750
DEFINE %152-08100800
PRIMARYUSER = HDR[2]#, % PRIV. USER CODE. %152-08100850
SAVEFACTOR = HDR[3].[2:10]#, % SAVE FACTOR. %152-08100900
LASTACCESSDATE = HDR[3].[12:18]#, % LAST ACCESS DATE. %152-08100950
CREATIONDATE = HDR[3].[30:18]#, % CREATION DATE. %152-08101000
GUARDFILEMFID = HDR[5]#, % MFID OF GUARD FILE. %152-08101050
GUARDFILEFID = HDR[6]#, % FID OF GUARD FILE. %152-08101100
PBDTUANDBUF = HDR[6].[39:9]#, % RJE TU/BUFF FOR PBD. %152-08101110
PBDTU = HDR[6].[39:4]#, % RJE TU NUMBER FOR PBD. %152-08101120
PBDBUF = HDR[6].[44:4]#, % RJE BUF NUMBER FOR PBD. %152-08101130
EOFPOINTER = HDR[7]#, % EOF POINTER. %152-08101150
SEGSPERROW = HDR[8]#, % SEG. POER ROW. %152-08101200
NOOFROWS = HDR[9].[43:5]#, % NO. OF ROWS DECLARED. %152-08101250
HEADERADDRESS = HDR.[CF]#; % CORE ADDRESS OF HEADER. %152-08101300
%******************** S U B R O U T I N E S **************************08101350
SUBROUTINE GETREADY; %152-08101400
% ---------- -------- %152-08101450
BEGIN %152-08101500
STA := M[(BUFF := (T:=BUFF).[15:15] -1) -1]; %152-08101520
$ SET OMIT = NOT(DATACOM) %152-08101540
INFO := 0 & (LC OR LF OR LS)[42:47:1] & LS[43:47:1]; %152-08101650
END OF GETREADY; %152-08101700
% %152-08101750
SUBROUTINE GETFILESPECIFIER; %152-08101800
% ---------- ---------------- %152-08101850
BEGIN %152-08101900
NAMEID(MFID,T); % GET MFID (OR USERCODE IF "LF") %152-08101950
IF LF THEN USERID := MFID; % FIRST THING IS USERID FOR LF. %152-08102000
IF MFID = "~~ " OR LF THEN %152-08102050
MFID := - 1; %152-08102100
NAMEID(FID,T); %152-08102150
IF FID = "/ " THEN % GET FID %152-08102200
BEGIN %152-08102250
NAMEID(FID,T); %152-08102300
NAMEID(N,T); % GET NEXT ITEM. %152-08102350
END %152-08102400
ELSE % NO FID SPECIFIED IMPLIES FID OF "=" %152-08102450
BEGIN %152-08102500
N := FID; %152-08102550
FID := -1; %152-08102600
END; %152-08102650
IF FID.[6:6] = LEFTARROW OR LF THEN % NO FID SPECIFIED %152-08102700
FID := - 1; %152-08102750
END OF GETFILESPECIFIER; %152-08102800
% %152-08102850
SUBROUTINE PROCESSOPTIONLIST; %152-08102900
% ---------- ----------------- %152-08102950
BEGIN %152-08103000
WHILE N ! "~ " DO % ACCUMULATE OPTIONS %152-08103050
BEGIN %152-08103100
FOR I := -1 STEP 1 UNTIL (NUMOPTS - 2) DO %152-08103150
DUMMY:: IF P(.OPTIONS,I,+,LOD) = N THEN % MATCHES AN OPTION WORD 08103200
BEGIN %152-08103250
INFO := INFO OR TWO(I+1); % SET BIT CORRESPONDING TO OPT08103300
GO TO DROPOUT; %152-08103350
END %152-08103400
ELSE % CHECK FOR "ALL" %152-08103450
IF N = "ALL " THEN % SET ALL OPTION WORD BITS. %152-08103500
INFO := NOT 0; %152-08103550
DROPOUT: %152-08103600
NAMEID(N,T); % GET NEXT OPTION WORD. %152-08103650
IF N = ", " THEN NAMEID(N,T); % SKIP OVER COMMA. %152-08103700
END; %152-08103750
GO TO EXIT; %152-08103800
% %152-08103850
OPTIONS ::: "RECS ", % OPTION 0 (INFO.[47:1]) %152-08103900
"LAST ", % OPTION 1 (INFO.[46:1]) %152-08103950
"DATE ", % OPTION 2 (INFO.[45:1]) %152-08104000
"SIZE ", % OPTION 3 (INFO.[44:1]) %152-08104050
"SECURIT", % OPTION 4 (INFO.[43:1]) %152-08104100
"CREATOR", % OPTION 5 (INFO.[42:1]) %152-08104150
"SAVE "; % OPTION 6 (INFO.[41:1]) %152-08104200
EXIT: %152-08104250
END OF PROCESSOPTIONLIST; %152-08104300
% %152-08104350
SUBROUTINE GETSET; %152-08104400
% ---------- ------ %152-08104450
BEGIN %152-08104500
IF EX OR INFO ! 0 OR (PD AND USERID ! 0) THEN % WE WILL NEED HDR. 08104550
HDR := IOQUE & SPACE(30) [CTC]; %152-08104600
END OF GETSET; %152-08104650
% %152-08104700
BOOLEAN SUBROUTINE WEGOTAFILE; %152-08104750
% ------- ---------- ---------- %152-08104800
BEGIN %152-08104850
SEEKNAM(MFID,FID,C,D,E,N,XLST); % FIND A FILE. %152-08104900
WEGOTAFILE := C ! 0; % C IS ADDRESS OF DISK HEADER. %152-08104950
END OF WEGOTAFILE; %152-08105000
% %152-08105050
BOOLEAN SUBROUTINE WEWANTTHISFILE; %152-08105100
% ------- ---------- -------------- %152-08105150
BEGIN %152-08105200
PBDTOG := ((D EQV "PBD ") = NOT 0 OR (D EQV "PUD ") %152-08105250
= NOT 0); %152-08105300
IF HEADERADDRESS ! 0 THEN % WE NEED THE HEADER. %152-08105350
DISKWAIT(-HEADERADDRESS,30,C); % READ HEADER. %152-08105400
IF LF THEN % CHECK TO SEE IF WE WANT THIS FILE. %152-08105450
WEWANTTHISFILE := PRIMARYUSER = USERID %152-08105500
ELSE %152-08105550
IF EX THEN %152-08105600
BEGIN %152-08105650
STREAM(A:=CALCULATEPURGE(-SAVEFACTOR),X:=[X]); %152-08105700
BEGIN %152-08105750
SI := LOC A; DS := 8 OCT; %152-08105800
END; %152-08105850
WEWANTTHISFILE := X > LASTACCESSDATE; % TRUE IF FILE EXPIRED08105900
END %152-08105950
ELSE %152-08106000
IF PD AND USERID ! 0 THEN % NEED TO CHECK SECURITY. %152-08106020
WEWANTTHISFILE := SECURITYCHECK(D,E,USERID,HEADERADDRESS)!0 08106040
ELSE %152-08106060
WEWANTTHISFILE := TRUE; %152-08106080
END OF WEWANTTHISFIE; %152-08106100
% %152-08106150
SUBROUTINE PUTINFILENAME; %152-08106200
% ---------- ------------- %152-08106250
BEGIN %152-08106300
STREAM(A:=0 : D, E, BUFF); % SET UP FILE NAME. %152-08106350
BEGIN %152-08106400
SI := LOC D; %152-08106450
DS := LIT " "; %152-08106500
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08106550
DI := DI - 1; %152-08106600
DS := 2 LIT " "; % NEED 2 SPACES TO ALLOW FOR ARROW. %152-08106650
A := DI; %152-08106700
END; %152-08106750
T := P; % SAVE OFF DEST. INDEX. %152-08106800
END OF PUTINFILENAME; %152-08106850
% %152-08106900
SUBROUTINE DORECS; %152-08106950
% ---------- ------ %152-08107000
BEGIN %152-08107050
STREAM(A:=IF PBDTOG THEN EOFPOINTER|5 ELSE EOFPOINTER+1 :T); %152-08107100
%152-08107150
BEGIN %152-08107200
DS := 9 LIT "RECORDS: "; %152-08107250
SI := LOC A; %152-08107300
DS := 8 DEC; % CONVERT NUMBER OF RECORDS TO DEC. %152-08107350
A := DI; % SAVE OFF DI BEFORE ZERO SUPPRESSING. %152-08107400
DI := DI - 8; %152-08107450
DS := 7 FILL; %152-08107500
END; %152-08107550
T := P; % SAVE DESTINATION ADDRESS. %152-08107600
END OF DORECS; %152-08107650
% %152-08107700
SUBROUTINE DODATEORLAST; %152-08107750
% ---------- ------------ %152-08107800
BEGIN %152-08107850
% %152-08107900
STREAM(X:=[X]); %152-08107950
BEGIN %152-08108000
SI := X; %152-08108050
DS := 8 DEC; % CONVERT DATE TO DECIMAL. %152-08108100
END; %152-08108150
GIMEDATE([X].[CF],-X); % CONVERT JUILIAN DATE TO 6 DIGITS. %152-08108200
STREAM(A:=(I=1) : X, T); %152-08108250
BEGIN %152-08108300
A ( DS := 10 LIT "ACCESSED: "; JUMP OUT TO L1); %152-08108350
DS := 9 LIT "CREATED: "; %152-08108400
L1: %152-08108450
SI := LOC X; %152-08108500
SI := SI + 2; %152-08108550
3 ( DS := 2 CHR; DS := LIT "/"); %152-08108600
DI := DI - 1; % ERASE THE EXTRA SLASH. %152-08108650
A := DI; % SAVE DEST. INDEX. %152-08108700
END; %152-08108750
T := P; % SAVE DESTINATION ADDRESS. %152-08108800
END OF DODATEORLAST; %152-08108850
% %152-08108900
SUBROUTINE DOSIZE; %152-08108950
% ---------- ------ %152-08109000
BEGIN %152-08109050
NT2 := NOOFROWS; % NO. OF ROWS DECLARED. %152-08109100
NT1 := 0; % NUMBER OF ROWS PROCESSED. %152-08109150
FOR J := 1 STEP 1 UNTIL NT2 DO % CHECK TO SEE IF ROW EXISTS. %152-08109200
IF HDR[J+9] ! 0 THEN NT1 := NT1 + 1; % BUMP UP COUNT. %152-08109250
STREAM(A:=NT1|SEGSPERROW : T); %152-08109300
BEGIN %152-08109350
DS := 10 LIT "SEGMENTS: "; %152-08109400
SI := LOC A; %152-08109450
DS := 8 DEC; %152-08109500
A := DI; %152-08109550
DI := DI - 8; %152-08109600
DS := 7 FILL; %152-08109650
END; %152-08109700
T := P; % SAVE DESTINATION ADDRESS. %152-08109750
END OF DOSIZE; %152-08109800
% %152-08109850
SUBROUTINE DOSECURITY; %152-08109900
% ---------- ---------- %152-08109950
BEGIN %152-08110000
J:= IF PRIMARYUSER = 0 THEN % FREE FILE %152-08110050
ELSE IF GUARDFILEMFID = "?" THEN % UNLOCK OR PUBLIC %152-08110100
IF GUARDFILEFID = "?" THEN 1 % UNLOCKED %152-08110150
ELSE 2 % PUBLIC %152-08110200
ELSE IF GUARDFILEMFID < 0 THEN 3 % PRIVATE %152-08110250
ELSE 4; % LOCKED %152-08110300
STREAM(J := A:=GUARDFILEMFID, B:=GUARDFILEFID, T); %152-08110350
BEGIN %152-08110400
DS := 10 LIT "SECURITY: "; %152-08110450
CI := CI + J; %152-08110500
GO TO FREE; %152-08110550
GO TO UNLOK; %152-08110600
GO TO PUBLIC; %152-08110650
GO TO PRIVATE; %152-08110700
LOCK: DS := 6 LIT "LOCKED"; GO TO EXIT; %152-08110750
PRIVATE:DS := 22 LIT "PRIVATE (SECURED WITH "; %152-08110800
SI := LOC A; %152-08110850
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08110900
DI := DI - 1; %152-08110950
DS := LIT ")"; %152-08111000
GO TO EXIT; %152-08111050
PUBLIC: DS := 6 LIT "PUBLIC"; GO TO EXIT; %152-08111100
UNLOK: DS := 8 LIT "UNLOCKED"; GO TO EXIT; %152-08111150
FREE: DS := 4 LIT "FREE"; %152-08111200
EXIT: J := DI; %152-08111250
END; %152-08111300
T := P; % SAVE DESTINATION ADDRESS. %152-08111350
END OF DOSECURITY; %152-08111400
% %152-08111450
SUBROUTINE DOCREATOR; %152-08111500
% ---------- --------- %152-08111550
BEGIN %152-08111600
$SET OMIT = PACKETS %152-08111650
$SET OMIT = NOT(PACKETS) %152-08111800
IF J:=(PBDTOG AND (E.[42:6] = 1)) THEN % REEL 1 OF PBD %152-08111850
$POP OMIT %152-08111900
BEGIN %152-08111950
IF LABELREC = 0 THEN LABELREC := SPACE(30); %152-08112000
DISKWAIT(-LABELREC,30,HDR[10]+2); %152-08112050
END; %152-08112100
STREAM(J : B:= PRIMARYUSER=0, C:=PRIMARYUSER, %152-08112150
RJE := PBDTUANDBUF!0, TU:=PBDTU, BUF:=PBDBUF, %152-08112175
D:=LABELREC INX 12, T); %152-08112200
BEGIN %152-08112250
DS := 9 LIT "CREATOR: "; %152-08112300
B ( DS := 4 LIT "NONE"; JUMP OUT TO L2 ); %152-08112350
SI := LOC C; %152-08112400
SI := SI + 1; %152-08112450
DS := 7 CHR; %152-08112500
L2: %152-08112550
J ( DS := 2 LIT " ("; %152-08112600
SI := D; %152-08112650
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08112700
DI := DI - 1; DS := 4 LIT " OF "; %152-08112750
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08112800
DI := DI - 1; %152-08112820
RJE (DS := 2 LIT " ["; SI := TU; %152-08112840
DS := 2 DEC; DS := LIT "/"; DS := 2 DEC; %152-08112860
DS := LIT "]"); %152-08112880
DS := LIT ")"); %152-08112890
J := DI; %152-08112900
END; %152-08112950
T := P; % SAVE DESTINATION ADDRESS. %152-08113000
END OF DOCREATOR; %152-08113050
% %152-08113100
SUBROUTINE DOSAVEFACTOR; %152-08113150
% ---------- ------------ %152-08113200
BEGIN %152-08113250
STREAM(A := SAVEFACTOR : T); %152-08113300
BEGIN %152-08113350
DS := 6 LIT "SAVE: "; %152-08113400
SI := LOC A; %152-08113450
DS := 3 DEC; %152-08113500
A := DI; %152-08113550
DI := DI - 3; %152-08113600
DS := 2 FILL; %152-08113650
END; %152-08113700
T := P; % SAVE DESTINATION ADDRESS; %152-08113750
END OF DOSAVEFACTOR; %152-08113800
% %152-08113850
SUBROUTINE DOOPTIONS; %152-08113900
% ---------- --------- %152-08113950
BEGIN %152-08114000
FOR I := 0 STEP 1 UNTIL (NUMOPTS - 1) DO % SEE IF OPTION BIT SET. 08114050
IF (TWO(I) AND INFO) ! 0 THEN %OPTION SELECTED. %152-08114100
BEGIN %152-08114150
CASE I OF %152-08114200
BEGIN %152-08114210
DORECS; % CASE 0 - "RECS" %152-08114250
BEGIN % CASE 1 - "LAST" %152-08114290
X := LASTACCESSDATE; %152-08114300
DODATEORLAST; %152-08114310
END OF CASE 1; %152-08114320
BEGIN % CASE 2 - "DATE" %152-08114340
X := CREATIONDATE; %152-08114350
DODATEORLAST; %152-08114360
END OF CASE 2; %152-08114370
DOSIZE; % CASE 3 - "SIZE" %152-08114400
DOSECURITY; % CASE 4 - "SECURITY" %152-08114450
DOCREATOR; % CASE 5 - "CREATOR" %152-08114500
DOSAVEFACTOR; % CASE 6 - "SAVE" %152-08114550
END OF CASES; %152-08114600
STREAM(I : T); % PUT COMMA AFTER LAST OPTION. %152-08114650
BEGIN %152-08114700
DS := 2 LIT ", "; %152-08114750
I := DI; %152-08114800
END; %152-08114850
T := P; %152-08114900
END OF LOOP TO PROCESS OPTIONS; %152-08114950
END OF DOOPTIONS; %152-08115000
% %152-08115050
SUBROUTINE MAKETHEMESSAGE; %152-08115100
% ---------- -------------- %152-08115150
BEGIN %152-08115200
IF FOUNDAFILE THEN % WE NEED A BUFFER. %152-08115250
BUFF := SPACE(30); %152-08115300
PUTINFILENAME; %152-08115350
DOOPTIONS; %152-08115400
STREAM(T); % PUT IN THE LEFT ARROW. %152-08115450
BEGIN %152-08115500
DI := DI -2; %152-08115550
DS := LIT LEFTARROW; %152-08115600
END; %152-08115650
END OF MAKETHEMESSAGE; %152-08115700
% %152-08115750
SUBROUTINE COMPLAIN; %152-08115800
% ---------- -------- %152-08115850
BEGIN %152-08115900
STREAM(BUFF); %152-08115950
DS := 8 LIT " NULL "; % ORIGINAL INPUT IS AT BUFF + 1, %152-08116000
SPOUT(BUFF INX STA); %152-08116050
END OF COMPLAIN; %152-08116100
% %152-08116150
SUBROUTINE FORGETEVERYTHING; %152-08116200
% ---------- ---------------- %152-08116250
BEGIN %152-08116300
IF HEADERADDRESS ! 0 THEN FORGETSPACE(HEADERADDRESS); %152-08116350
IF LABELREC ! 0 THEN FORGETSPACE(LABELREC); %152-08116400
END OF FORGETEVERYTHING; %152-08116450
%******************** S T A R T O F C O D E ***********************08116500
GETREADY; %152-08116550
GETFILESPECIFIER; %152-08116600
PROCESSOPTIONLIST; %152-08116650
GETSET; %152-08116700
WHILE WEGOTAFILE DO %152-08116750
IF WEWANTTHISFILE THEN %152-08116800
BEGIN %152-08116850
MAKETHEMESSAGE; %152-08116900
SPOUT(BUFF INX STA); %152-08116950
FOUNDAFILE := TRUE; %152-08117000
END; %152-08117050
IF NOT FOUNDAFILE THEN COMPLAIN; %152-08117100
FORGETEVERYTHING; %152-08117150
END OF PRINTDIRECTORY; %152-08117200
$ SET OMIT = NOT(DCSPO AND DATACOM ) 08135999
PROCEDURE CONTINUITYBIT;% 08171000
BEGIN REAL T,IOD,LINK,U;% 08172000
ARRAY A[*]; 08172500
REAL RCW=+0;% 08173000
ARRAY R=-4[*]; DEFINE FIB=A#; %P 08173100
CHECKSTACKSPACE;% %WF 08173200
U ~(LINK ~ NFLAG(M[(IOD ~ NFLAG(M[T~PRT[P1MIX,9]]) INX% 08174000
P(0,LNG,XCH)) INX NOT 0])).[12:6];% 08175000
IF U } 32 THEN 08175100
BEGIN A ~ M[T]; 08175200
IF READEMFROMDISK(CIDROW[U-32],A) THEN 08175300
M[T] ~ A&1[27:47:1]&0[2:47:1] ELSE 08175400
M[1] ~ R; GO TO RETURN; 08175500
END; 08175600
M[IOD INX NOT 1]~FLAG(LINK); FIB~M[T-3]; %P 08176000
M[FIX[14]INX 17]~[M[FIB[5].[FF]]]&IOD[3:3:30]&0[20:20:1]; 08177000
;FIB[5]~P(DUP,LOD,0,1,CFX,ADD); %P 08177100
IF FIB[14].[FF]{FIB[14].[CF] THEN %% BUFFER FULL %P 08177200
PBIO(T,FIB[14]) %P 08178000
ELSE %P 08179000
BEGIN; STREAM(A~FIB[14].[CF], B~FIB[14].[FF]); %P 08179600
BEGIN SI~A; DS~18 WDS END; %P 08179700
FIB[14].[FF]~FIB[14].[FF]-18; %P 08179800
END; %P 08179900
GO RETURN %P 08180000
END CONTINUITYBIT; %P 08181000
BOOLEAN PROCEDURE PRINTORPUNCHWAIT(Q,PNCH);VALUE Q,PNCH;REAL Q,PNCH; 08255000
% 08255050
% THIS PROCEDURE IS RESPONSIBLE FOR STARTING PRNPBT/DISK. IT CHECKS 08255055
% FOR I/O UNITS AS REQUIRED AND, IF AVAILABLE, GRABS THEM. THE 08255060
% PARAMETERS ARE: 08255065
% Q {-16 LOGICAL UNIT NUMBER FOR OUTPUT. TAPES AND DISK ARE 08255070
% SEARCHED TO FIND A FILE TO PRINT. THIS IS USED ONLY 08255075
% WHEN AUTOPRINT IS SET OR FOR RJE. 08255080
% >-16, {0 LOGICAL UNIT NUMBER OF A BACK-UP TAPE. CHECK FOR AN 08255085
% AVAILABLE OUTPUT UNIT. 08255090
% >0 FID OF A DISK FILE. CHECK FOR OUTPUT UNIT. 08255095
% PNCH.[47:1] ON FOR PUNCH BACK-UP. 08255100
% [39:8] NUMBER OF COPIES FROM PB MESSAGE. 08255105
% [31:8] IF TAPE, NUMBER OF FILE TO PRINT (FROM PB). 08255110
% IF DISK, =0 IF ENTRIE PACKET SHOULD BE PRINTED, =1 IF08255115
% NOT. 08255120
% [30:1] ON IF =0 WAS USED IN PB MSG. 08255122
% [9:9] RJE TU/BUFF. 08255125
% [2:1] ON IF CALLED FROM PRINTBACKUP, I.E, A PB MESSAGE. 08255130
% [1:1] ON IF CALLED FROM PRNPBT/DISK. 08255135
% 08255140
BEGIN INTEGER U,V,I,J,J1,J2,S; 08255200
REAL A,HDR,SEG0=S,F=J; 08255400
REAL PBT,PBD,PUD; 08255500
ARRAY D[*],SHEAT=D[*]; 08255600
LABEL TRYAGAIN,PRNPBT,DISK; 08255700
LABEL FOUND,FIREITUP,QUIT; %717-08255800
DEFINE MFID = (IF V=22 THEN PUD ELSE PBD)#; 08255900
DEFINE STACURR = STATION[STA.[44:4],STA.[39:4]]#; 08256000
$ SET OMIT = SHAREDISK 08256190
DEFINE SIXTY = 60%; 08256200
$ SET OMIT = NOT SHAREDISK 08256210
$ SET OMIT = NOT RJE 08256390
% 08256420
SUBROUTINE LABELTHEPRINTER; 08256430
BEGIN LABELTABLE[V]:=Q&@21[1:43:5]; 08256440
MULTITABLE[V]:=IF V=22 THEN PUD ELSE PBD; 08256450
END; 08256460
% 08256470
PBT := "PBT "; PUD := "PUD "; PBD := "PBD "; 08256500
$ SET OMIT = NOT(DATACOM AND RJE ) 08256699
IF Q}(-15) THEN %%% PR GIVEN: LOOK FOR LP. 08257000
BEGIN 08257100
$ SET OMIT = NOT(DATACOM AND RJE ) 08257199
IF PNCH THEN IF LABELTABLE[V:=22]!0 THEN V:=0 ELSE ELSE 08257500
IF LABELTABLE[V~20]!0 THEN 08257600
IF LABELTABLE[V~21]!0 THEN V~0; 08258000
IF V!0 THEN % WE HAVE AN OUTPUT UNIT 08258200
IF Q>0 THEN % BACK-UP DISK 08258400
BEGIN U:=18; 08258600
LABELTHEPRINTER; % TO HOLD IT DURING DISK I/O-S. 08258700
IF AUTOPRINT % CHECK IF A PRNPBT WAS STARTED; 08258800
$ SET OMIT = NOT RJE % IF SO, START THIS ONLY FOR PB. 08258990
THEN 08259200
IF (A:=DIRECTORYSEARCH(MIFD,Q,19))!0 THEN 08259225
BEGIN IF M[A+4].[6:1] THEN% NOT FIRST TIME. 08259250
BEGIN 08259275
$ SET OMIT = NOT SHAREDISK 08259300
P(PNCH.[2:1]); % SEE 08259625 08259375
END ELSE % FIRST TIME, MARK IT. 08259400
BEGIN M[A+4].[6:1]:=1; 08259425
DISKWAIT(A.[CF],-30,A.[FF]); 08259450
P(1); 08259475
END; 08259500
FORGETSPACE(A); 08259525
$ SET OMIT = SHAREDISK 08259550
UNLOCKDIRECTORY; 08259575
$ POP OMIT 08259600
IF P THEN ELSE GO QUIT; 08259625
END ELSE GO QUIT; 08259650
GO FIREITUP; 08259700
END ELSE % Q{0, PB MT %717-08259800
BEGIN RRRMECH~TWO(U~ABS(Q)) OR RRRMECH; %717-08259810
LABELTABLE[U] ~ %717-08259820
PBT&TINU[V][6:30:18]&@21[1:43:5]; %717-08259830
MULTITABLE[V] ~ PBT; %717-08259840
LABELTABLE[V] ~ PBT&TINU[U][6:30:18]& %717-08259850
@21[1:43:5]; %717-08259860
GO FIREITUP; %717-08259870
END %717-08259880
ELSE GO QUIT; % V =0, NO OUTPUT UNIT 08260000
END; 08260250
BEGIN V:=ABS(Q); % LP (OR PUNCH) GIVEN, LOOK FOR FILE. 08260500
IF PBCOUNT!0 THEN % TRY FOR DISK 08267000
BEGIN D:=[M[SPACE(90)]]&90[8:38:10]; 08267500
$ SET OMIT = SHAREDISK 08267990
LOCKDIRECTORY; 08268000
$ POP OMIT 08268010
A:=MFID; 08268500
J1:=(A.[6:18] + A.[24:24]) MOD MODULUS; 08268600
FOR J2:=0 STEP 1 UNTIL (MODULUS-1) DO 08268700
BEGIN 08268750
$ SET OMIT = NOT SHAREDISK 08268790
J:=SCRAMBLE(J1,J2); 08268900
DO BEGIN DISKWAIT(-(D INX 30),SIXTY,J); 08268950
FOR I:=30 STEP 3 UNTIL 87 DO 08269000
IF (D[I] EQV A) = NOT 0 THEN 08269100
IF D[I+1].[CF]=1 THEN 08269200
BEGIN DISKWAIT(-D.[CF],-30,D[I+2].[CF]); 08269300
IF D[4].[1:3] ! 0 OR D[4].[6:1] 08269400
$ SET OMIT = NOT(RJE AND DATACOM ) 08269499
$ SET OMIT = NOT(PACKETS) 08269509
OR LABELTABLE[IF V=20 THEN 21 ELSE 08269510
IF V=21 THEN 20 ELSE 22].[6:24] 08269520
=D[I+1].[6:24] 08269530
$ POP OMIT 08269531
OR (D[4].[16:20] OR D[9].[1:28])!0 08269600
THEN 08269650
$ SET OMIT = NOT SHAREDISK 08269690
ELSE 08269750
BEGIN D[4].[6:1]:=1; 08269800
PBCOUNT:=PBCOUNT-1; 08269900
DISKWAIT(D.[CF],-30,D[I+2].[CF]);08270000
$ SET OMIT = NOT SHAREDISK 08270040
U:=18; 08270100
Q:=D[I+1]; 08270200
GO FOUND; 08270300
END END; 08270350
$ SET OMIT = NOT SHAREDISK 08270390
END UNTIL (J:=D[32].[FF])=0; 08270450
$ SET OMIT = NOT SHAREDISK 08270490
END; 08270550
FOUND: FORGETSPACE(D); 08270600
$ SET OMIT = SHAREDISK 08270640
UNLOCKDIRECTORY; 08270650
$ POP OMIT 08270660
END SEARCHING FOR DISK; 08270700
END; 08270725
% IF WE HAVE BOTH AN INPUT FILE AND AN OUTPUT UNIT, 08270740
% FIRE UP PRNPBT/DISK. 08270745
IF U!0 AND V!0 THEN 08270750
BEGIN 08270800
$ SET OMIT = NOT(DATACOM AND RJE ) 08270819
LABELTHEPRINTER; 08271000
FIREITUP: 08271750
A:=V&U[38:43:5]&PNCH[21:30:17]; 08272000
$ SET OMIT = NOT RJE 08272240
IF PNCH.[1:1] THEN P(A) ELSE 08272250
BEGIN 08272500
TRYAGAIN: 08272600
IF (HDR:=DIRECTORYSEARCH(P(PRNPBT),P(DISK),3)) ! 0 THEN 08272750
BEGIN 08273000
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV)]]&30[SIZE]; 08273250
M[F-1].[9:6] := 0; M[HDR INX NOT 1],[9:6]:=0; 08273260
MOVE(30,F-1,F); 08274500
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-08275500
M[SEG0-2].[AREAMIXF] := 0;% %167-08275600
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 08275750
F.[FF] := HDR; % CORE ADDRESS OF HEADER 08276000
SHEAT[7] := SEG0; % CORE ADDRESS OF SEGMENT ZERO 08276050
SHEAT[0] := P(PRNPBT); 08276100
SHEAT[1] := P(DISK); 08276150
SHEAT[2] := 0 & PRBPBTCODE[5:45:3] & 2[8:38:10] & 08276200
%PRIORITY=0.EXECUTE CODE 08276203
(PNCH.[2:1]=0)[4:47:1]; % SET IF NOT "PB" 08276205
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS08276210
SHEAT[19] := A; % COMMON VALUE 08276220
SHEAT[20] := 4; % CORE ESTIMATE 08276230
SHEAT[21] := 150; % STACK SIZE 08276240
08276250
STREAM(A:=0: S:=P(.SCHEDULEIDS)); 08276260
BEGIN 08276270
SI:=S; 08276280
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 08276290
IF SB THEN ELSE JUMP OUT); 08276300
DS:=SET; A:=TALLY; 08276310
END STREAM STATEMENT; 08276320
08276330
I := P; 08276340
SHEAT[3].[8:10] := I; % SCHEDULE NUMBER 08276350
SHEAT[23] := (CLOCK + P(RTR)) DIV 60); 08276360
SHEAT[24] := MCP; %131-08276365
$ SET OMIT = NOT(DATACOM AND RJE) 08276370
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 08276400
STREAM(A, I:=I:=SPACE(11)); 08276410
BEGIN 08276420
DI:=DI+16; 08276430
DS:=30LIT"CC EXECUTE PRNPBT/DISK;COMMON="; 08276440
SI:=LOC A; DS:=8DEC; 08276450
DS:=6LIT";END.~"; 08276460
END STREAM STATEMENT; 08276470
M[I] := 0; M[I+1]:=10; 08276480
SHEAT[6] := GETESPDISK & 10[18:33:15]; 08276490
DISKWAIT(I, 11, SHEAT[6].[CF]); 08276500
FORGETSPACE(I); 08276510
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 08276520
P(1); 08276530
END ELSE % IF IN DIRECTORY 08276540
BEGIN 08276550
ENTERSYSFILE(3); 08276560
GO TRYAGAIN; 08276570
PRNPBT::: "PRNPBT "; 08276580
DISK::: "DISK "; 08276590
END; 08276600
END; 08277000
PRINTORPUNCHWIAT:=P; 08277500
END ELSE 08278000
08279000
QUIT: IF V NEQ 0 THEN 08280000
$ SET OMIT = NOT(RJE AND DATACOM ) 08280009
LABELTABLE[V]:=MULTITABLE[V]:=0; 08280030
END PRINTWAIT;% 08281000
PROCEDURE PRINTBACKUP(BUFF); VALUE BUFF; REAL BUFF; %P 08282000
% 08282100
% THIS PROCEDURE HANDLES THE PB MESSAGE, MAKING THE NECESSARY CHECKS 08282110
% AND THEN CALLING PRINTORPUNCHWIAT. THE SYNTAX OF THE MESSAGE IS: 08282120
% <PB MSG> ::= PB<INPUT FILE><PB SPECS> 08282140
% <INPUT FILE> ::= <TAPE UNIT> / <DISK FILE NUMBER> 08282150
% <PB SPECS> ::= <PB ELEMENT> / <PB ELEMENT><PB SPECS> / <EMPTY> 08282160
% <PB ELEMENT> ::= P / =<NUMBER OF COPIES> / #<STARTING FILE NUMBER>08282170
% 08282180
BEGIN REAL U,I,COPY,MS,STA,B=BUFF; 08283000
$ SET OMIT = NOT (DATACOM AND DCSPO) 08283400
LABEL OK,BAD,SPIT; 08284000
$ SET OMIT = NOT (DATACOM AND DCSPO) 08284450
STREAM(PCPY:=1, NUMB:=1, N:=1, CPY:=-0: B:=BUFF); 08285000
BEGIN SI~B; DI~LOC N; %P 08286000
L: IF SC=" " THEN BEGIN SI~SI+1; GO TO L END; %P 08287000
IF SC<"0" THEN BEGIN DS~5 LIT"+0000"; DS~3 CHR END ELSE%P 08288000
BEGIN B:=SI; 08289000
4(IF SC<"0" THEN JUMP OUT; TALLY~TALLY+1; SI~SI+1); 08289500
SI:=B; B:=TALLY; DI:=DI+5; DI:=DI-B; 08290000
DS~B CHR; %P 08290500
END; 08291000
LL: IF SC=" " THEN BEGIN SI:=SI+1; GO TO LL END; 08291025
IF SC="=" THEN BEGIN DI:=LOC CPY; GO TO CNT END; 08291050
IF SC="#" THEN 08291075
BEGIN DI:=LOC NUMB; 08291100
CNT: SI:=SI+1; B:=SI; IF SC=" " THEN GO TO CNT;TALLY:=0; 08291125
3(IF SC < "0" THEN JUMP OUT; 08291150
IF SC > "9" THEN JUMP OUT; 08291175
TALLY:=TALLY+1; SI:=SI+1); 08291200
SI:=B; B:=TALLY; DS:=8 OCT; 08291225
GO TO LL; 08291250
END; 08291275
IF SC="P" THEN 08291300
BEGIN TALLY:=0; PCPY:=TALLY; SI:=SI+1; 08291325
5(IF SC=ALPHA THEN IF SC<"0" THEN SI:=SI+1 ELSE 08291350
JUMP OUT ELSE JUMP OUT); 08291375
GO TO LL; 08291400
END; 08291425
END; 08291450
COPY:=(COPY:=P)&(NOT COPY = NOT 0)[31:47:1]; 08291460
% 08291470
% BACK UP TAPE. CHECK THE LABEL THEN CALL PRINTORPUNCHWAIT. 08291475
% 08291480
IF (U:=P) < 0 THEN 08291500
BEGIN COPY:=COPY&(P(XCH)-1)[32:40:8]; 08291750
IF NOT MTXIN(I,U,B) THEN 08292000
IF (STA:=MULTITABLE[U]!"PBTMCP " OR STA) AND 08292500
MULTITABLE[U]!"PUTMCP " THEN 08293000
BEGIN STREAM(BUFF); DS:=19 LIT" NOT A BACKUP TAPE~"; 08293500
GO TO SPIT; 08294000
END 08294500
ELSE 08295000
IF PRINTORPUNCHWAIT(-U, STA&COPY[30:31:17] OR M) THEN 08295200
GO TO OK ELSE BEGIN MS:=-1; GO TO BAD END 08295600
ELSE GO TO SPIT; 08295800
END; 08296000
% BACK UP DISK. SET FIRST REEL NUMBER. IF COPIES OR REEL NUMBER 08296160
% GIVEN, DISK IN "P" BIT, ELSE LEAVE IT OFF TO PRINT ENTIRE 08296170
% THING. CHECK FOR THE FILE, THEN CALL PRINTORPUNCHWAIT. 08296180
% 08296190
% 08296200
STREAM(I:=P: U:=[U]); 08296225
BEGIN SI:=LOC I; DI:=DI+5; 08296250
DS:=3 DEC; 08296275
END; 08296300
I:=P-1; 08296325
IF (COPY OR I).[CF]=0 THEN P(DEL) ELSE 08296350
COPY:=COPY&P(XCH)[39:47:1]; 08296375
BUFF:=BUFF.[15:15]-1; 08296400
IF (I:=DIRECTORYSEARCH("PBD ",U,5))=0 THEN 08296600
IF (I:=DIRECTORYSEARCH("PUD ",U,5))=0 THEN GO TO BAD 08296800
ELSE STA:=STA OR 1; 08297000
P(M[I+4]); 08297200
FORGETSPACE(I); 08297300
IF P.[2:1] THEN BEGIN MS:=2; GO TO BAD END; 08297400
IF PBCOUNT LSS 1 THEN PBCOUNT:=1; 08297600
IF PRINTORPUNCHWAIT(U, STA&COPY[30:31:17] OR M) THEN 08298000
OK: FORGETSPACE(BUFF) 08298200
ELSE 08298400
BEGIN MS:=1; 08298600
BAD: STREAM(MS, X:=MS<0, U:=IF P(DUP) THEN TINU[U] ELSE U, 08298800
BUFF:=BUFF.[CF]); 08299000
BEGIN DS:=8 LIT" NULL PB"; 08299200
SI:=LOC U; CI:=CI+X; GO TO DK; 08299400
SI:=SI+5; DS:=3 CHR; GO TO LL; 08299600
DK: SI:=SI+1; DS:=4 CHR; 08299800
BUFF:=DI; DI:=DI-4; DS:=3 FILL; DI:=BUFF; 08300000
LL: DS:=2 LIT"-("; 08300200
CI:=CI+MS; GO TO L0; GO TO L1; 08300400
DS:= 6 LIT"IN USE"; GO TO L; 08300600
L1: DS:=14 LIT"NO OUTPUT UNIT"; GO TO L; 08300800
L0: DS:=11 LIT"NOT ON DISK"; 08301000
L : DS:= 2 LIT")~"; 08301200
END; 08301400
SPIT: SPOUT(BUFF 08301600
$ SET OMIT = NOT (DATACOM AND DCSPO) 08301650
); 08301800
END; 08302000
END OF PB KEYBOARD MESSAGE HANDLER; 08302500
SAVE PROCEDURE INITIALIZE; FORWARD; 08303000
REAL ACTDATE=INITIALIZE; 08303100
SAVE REAL PROCEDURE COREND; FORWARD; 08303200
REAL WEEKDAY=COREND; 08303300
PROCEDURE TIMEOUT (B); VALUE B; REAL B;% 08305000
BEGIN INTEGER M,H,C;% 08306000
C ~XCLOCK/3600;% 08307000
M ~ C MOD 60;% 08308000
H ~ C DIV 60;% 08309000
STREAM(H,M,B);% 08310000
BEGIN DS ~ 9 LIT " TIME IS ";% 08311000
SI ~ LOC H; DS ~ 2 DEC; DS ~ 2 DEC;% 08312000
DS ~ LIT "~"% 08313000
END;% 08314000
SPOUT(B INX MEMORY[B-1]); 08315000
END;% 08316000
PROCEDURE GIMEDATE(B,DT); VALUE B,DT; REAL B,DT; 08317000
%% PARAMETER USE IS: 08317100
%% B=OUTPUT AREA FOR MESSAGE OR DATE 08317200
%%DT=0 RECONVERT ACTDATE,WEEKDAY THEN SPOUT TIME MSG 08317300
%% DT>0 SPOUT TIME MSG ONLY 08317400
%% DT<0 CONVERT MMDDYY USING DT (ACTDATE,WEEKDAY NOT CHANGED) 08317500
BEGIN REAL M,D,Y,NCV,NMG; 08318000
REAL SUBROUTINE DAY; 08318100
BEGIN;STREAM(M:X~0,Y~0,Z~0); 08318200
BEGIN DI~LOC X; DS~24 LIT"000~0%1.1Y2G2V3D3T4A4 5>";08318300
DI~LOC X; SI~SI+M; SI~SI+M; 08318400
DI~LOC M; DI~DI+6; DS~2 CHR; 08318500
END; 08318600
DAY~P; 08318700
END DAY; 08318800
LABEL DAYS; 08318900
LABEL ON;;% 08319000
IF NOT (NCV~(DT>0)) THEN % NOT PRINT ONLY 08319700
BEGIN 08319900
STREAM(DATE~IF (NMG~DT.[1:1]) THEN DT ELSE DATE,R~[Y]); 08320000
BEGIN SI ~ LOC DATE; SI ~ SI+3;% 08321000
DS~2 OCT; DI~DI-16; DS~3 OCT; 08322000
END;% 08323000
IF Y MOD 4 = 0 AND Y ! 0 THEN% 08324000
BEGIN IF D = 60 THEN% 08325000
BEGIN M~2; GO ON END; 08326000
IF D > 60 THEN D ~D-1;% 08327000
END;% 08328000
FOR M~1 STEP 1 UNTIL 11 DO 08329000
IF DAY}D THEN GO ON; 08330000
ON: M~M-1; 08331000
D~D-DAY; 08332000
IF M<2 THEN P(Y-1,M+11) ELSE P(Y,M-1); 08332100
P(26,|,2,-,10,IDV,D,+,XCH,P(DUP).[36:10],+,+,7,RDV,5,ISN);08332200
:: P(.DAYS,+,LOD); 08332300
M~M+1; 08332400
END ELSE P(WEEKDAY); 08332500
STREAM(M~[M],NMG,NCV,MDY~[ACTDATE],B,DATE,DW~[WEEKDAY]); 08333000
BEGIN NMG(JUMP OUT TO NOMSG); 08334000
SI~LOC M; SI~SI-16; 08334100
NCV(SI~SI+2; JUMP OUT TO NOCNV); 08334300
DS~WDS; SI~SI-6; 08334500
NOCNV: DI~B; DS~9 LIT" DATE IS "; DS~6 CHR; 08334700
DS~5 LIT"DAY, "; B~DI; NCV(JUMP OUT TO NULCV); 08334900
NOMSG: SI~M; NMG(DI~B; JUMP OUT TO NULMS); 08335000
DI~MDY; 08335200
NULMS: DS~4 DEC; DS~2 DEC; DS~2 DEC; 08335400
NMG(JUMP OUT TO OXIT); DI~B; 08335600
NULCV: SI~MDY; SI~SI+2; 08335800
DS~2 CHR; 2(DS~LIT "/"; DS~2 CHR); 08336000
DS:=2 LIT"-("; SI:=LOC DATE; 08336500
SI:=SI+3; DS:=5 CHR; DS:=2 LIT")~"; 08337000
SI:=B; 08337500
3(DI ~ B; DS ~ FILL; SI ~ SI+3; B ~SI);% 08338000
OXIT: END; 08339000
IF DT}0 THEN 08339500
IF NOT NMG THEN SPOUT(B INX MEMORY[B-1]); 08340000
P(XIT); 08340100
DAYS::: " MON"," TUES","WEDNES"," THURS"," FRI"," SATUR", 08340200
" SUN"; 08340300
END;% 08341000
DEFINE DATEOUT(DATEOUT1)=GIMEDATE(DATEOUT1,0)#; %CHANGE DATE & SPOUT IT 08342000
PROCEDURE SETDATE(BUFF); VALUE BUFF; REAL BUFF;% 08343000
BEGIN REAL DY,MN,YR; INTEGER D=DY; REAL B,T=MN; 08344000
REAL SUBROUTINE C; 08344100
BEGIN;STREAM(C~0:B~[B]); 08344200
BEGIN% 08345000
SI ~ B; SI ~ SI+5; SI ~ SC;% 08346000
L: IF SC < "0" THEN% 08347000
BEGIN IF SC = "~" THEN GO TO X;% 08348000
SI ~ SI+1; GO TO L;% 08349000
END;% 08350000
K: IF SC } "0" THEN% 08351000
BEGIN TALLY ~ TALLY+1;% 08352000
SI ~ SI+1; GO TO K END;% 08353000
DI ~ B; B ~ SI; SI ~ LOC B; DS ~ WDS;% 08354000
SI ~ B; B ~ TALLY; DI ~ LOC C;% 08355000
SI ~ SI-B; DS ~ B OCT;% 08356000
X:END;% 08357000
C~P;% 08358000
END C; 08358100
B ~ BUFF;% 08359000
MN~C; DY~C; YR~C;% 08360000
BUFF ~ BUFF.[15:15]-1;% 08361000
IF MN > 0 AND MN { 12 AND% 08362000
DY > 0 AND DY { 31 AND% 08363000
YR > 0 THEN% 08364000
BEGIN;STREAM(M~MN-1:X~0,Y~0,Z~0); 08365000
BEGIN DI~LOC X; DS~24 LIT"000~0%1.1Y2G2V3D3T4A4 5>";08365100
SI~LOC X; SI~SI+M; SI~SI+M; 08365200
DI~LOC M; DI~DI+6; DS~2 CHR; 08365300
END; 08365400
DY~P+DY; 08366000
IF YR MOD 4 = 0 AND MN > 2 AND(YR MOD 100 ! 0 OR% 08367000
YR MOD 400 = 0) THEN% 08368000
DY ~ DY+1;% 08369000
D ~ YR MOD 100 | 1000+DY;% 08370000
STREAM(D,A~[DATE]);% 08371000
BEGIN SI ~ LOC D; DS ~ 8 DEC END;% 08372000
CHANGEDATE(BUFF);% 08373000
END ELSE SPOUT(BUFF INX MEMORY[BUFF -1]); 08374000
END;% 08375000
PROCEDURE CHANGEDATE(BUFF); VALUE BUFF; REAL BUFF;% 08376000
BEGIN REAL B,C,D,T;% 08377000
SLEEP([TOGLE],HOLDMASK); 08378000
LOCKTOG(HOLDMASK); 08379000
B ~ SPACE(30);% 08380000
DISKWAIT(-B,-30,DIRECTORYTOP); 08381000
D:= M[B+1];% 08381100
M[B+1] ~ DATE;% 08383000
M[B+18]:=XCLOCK; 08383100
DISKIO(T,B-1,-30,DIRECTORYTOP); 08384000
IF BUFF!0 THEN 08384100
BEGIN% 08384200
DATEOUT (BUFF);% 08385000
C := TYPEDSPACE(5,MAINTBUFFAREAV);% %167-08385100
M[C ]:= M[C+2]:= 0;% 08385200
M[C+3]:= D;% 08385300
STREAM(DATE,A:=C+1); BEGIN SI:=LOC DATE; DS:=8 OCT; END;% 08385400
LINKUP(17,C);% 08385500
END;% 08385600
SLEEP([T],IOMASK);% 08386000
FORGETSPACE(B);% 08387000
UNLOCKTOG(HOLDMASK); 08388000
END;% 08389000
PROCEDURE SETIME(BUFF); VALUE BUFF; REAL BUFF;% 08390000
BEGIN REAL B=BUFF,T;% 08391000
REAL I,R;% 08392000
LABEL EXIT;% 08393000
REAL CLOCK=XCLOCK;% 08394000
INTEGER CLCK=CLOCK;;% 08395000
T ~ -1;% 08396000
STREAM(B,T~[T]);% 08397000
BEGIN SI ~ B;% 08398000
L: IF SC = " " THEN% 08399000
BEGIN SI ~ SI+1; GO TO L END;% 08400000
IF SC < "0" THEN GO TO X;% 08401000
K: IF SC } "0" THEN% 08402000
BEGIN SI ~ SI+1; TALLY ~ TALLY+1;% 08403000
GO TO K END;% 08404000
B ~ TALLY; SI ~ SI-B; DS ~ B OCT;% 08405000
X:% 08406000
END;% 08407000
BUFF ~ BUFF.[15:15]-1;% 08408000
IF T } 0 AND T DIV 100 < 24 AND T MOD 100 < 60 THEN% 08409000
BEGIN R := TYPEDSPACE(5,MAINTBUFFAREAV);% %167-08410000
M[R+2]:= XCLOCK;% 08410100
CLCK:= (T DIV 100 | 60 + T MOD 100)|3600;% 08410200
CLOCK ~ (CLOCK OR @77)+1;% 08411000
TIMEOUT (BUFF);% 08412000
M[R]:= M[R+3]:= 0;% 08412100
STREAM(DATE,A:=R+1);% 08412200
BEGIN SI:=LOC DATE; DS:=8 OCT; END;% 08412300
LINKUP(17,R);% 08412400
GO TO EXIT;% 08413000
END;% 08414000
SPOUT(BUFF INX MEMORY[BUFF-1]); 08415000
EXIT:% 08416000
END;% 08417000
REAL PROCEDURE FORMESS(BUFF,H1); VALUE BUFF,H1; REAL BUFF,H1; 08418000
BEGIN REAL B,H,U,M1; 08418500
INTEGER I; 08418700
LABEL AGAIN,EXIT,AWAY; 08419000
M1:=M[BUFF.[15:15]-2]; 08419100
STREAM(BUFF:); 08419200
BEGIN SI:=BUFF; 08419300
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 08419400
BUFF:=SI; 08419500
END; 08419600
BUFF:=P; 08419700
AGAIN: U:=FORMESS:=UNITIN(TINU,BUFF); 08420000
IF U{31 THEN BEGIN SLEEP([TOGLE],STATUSMASK); 08421000
IF LABELTABLE[U] < 0 THEN% 08422000
BEGIN STREAM(A:=TINU[U],B:=B:=SPACE(5)); 08424000
BEGIN SI ~ LOC A; SI ~ SI + 5; DS ~ 3 CHR;% 08425000
DS:=24LIT" IN USE(TO BE READIED)~"; 08426000
END;% 08427000
SAVEWORD := SAVEWORD AND NOT TWO(U); 08427100
SPOUT(B); 08428000
IF H1 THEN GO AWAY ELSE GO TO EXIT; 08429000
END; 08429500
LABELTABLE[U]:=@114&H1[1:47:1]; 08430000
MULTITABLE[U] ~ 0;% 08431000
I ~ TWO(U);% 08432000
IF H1 THEN B:=NOT 0 ELSE 08433000
BEGIN B:=NOT I; H:=I:=0; 08434000
IF U=23 THEN H:=P(.READERA); 08434100
IF U=24 THEN H:=P(.READERB); 08434200
IF H!0 THEN 08434300
BEGIN UNITCODE[U-23]:=-0; 08434400
IF (*H).[CF]!0 THEN 08434500
BEGIN FORGETSPACE(*H-2); 08434600
M[H]:=0; 08434700
END; 08434800
END; 08434900
END; 08434950
READY ~ READY AND B OR I;% 08435000
RRRMECH ~ RRRMECH AND B OR I;% 08436000
SAVEWORD ~ SAVEWORD AND B OR I;% 08437000
END; 08437050
EXIT: IF NOT H1 THEN 08437100
BEGIN IF U GTR 31 THEN 08437150
BEGIN STREAM(BUFF,B:=B:=SPACE(5)); 08437200
BEGIN DS:=10 LIT"INV KBD RY"; 08437250
SI:=BUFF; DS:=3 CHR; 08437300
DS:=LIT"~"; 08437350
END; 08437400
SPOUT(B INX M1); 08437450
END; 08437500
STREAM(OK:=0,BUFF:); 08437550
BEGIN SI:=BUFF; 08437600
3(IF SC=" " THEN JUMP OUT; 08437650
IF SC="," THEN JUMP OUT; 08437700
IF SC="~" THEN JUMP OUT TO L3; 08437750
SI:=SI+1); 08437800
L1: IF SC=" " THEN 08437850
L2: BEGIN SI:=SI+1; GO TO L1 END; 08437900
IF SC="," THEN GO TO L2; 08437950
BUFF:=SI; 08438000
IF SC!"~" THEN TALLY:=1; 08438050
L3: OK:=TALLY; 08438100
END; 08438150
BUFF:=P; 08438200
IF P THEN GO AGAIN; 08438250
AWAY: FORMESS:=-1; 08438300
END; 08438350
I:=SPACE(30); %146-08438400
DISKWAIT(-I,30,DIRECTORYTOP-SYSNO); %146-08438410
M[I+29]:=SAVEWORD; %146-08438420
DISKWAIT( I,30,DIRECTORYTOP-SYSNO); %146-08438430
FORGETSPACE(I); %146-08438440
END; 08438500
PROCEDURE SUSTATUS(A,DDD,B); VALUE A,DDD,B; REAL A,B; ARRAY DDD[*]; 08438900
FORWARD; 08438910
PROCEDURE OUTPUTLABEL(B); VALUE B; REAL B;% 08439000
BEGIN REAL BU=B,U,T,A;% 08440000
REAL G,Q;% 08441000
REAL TUSTA,TEMP; 08441050
BOOLEAN SCHTOG; 08441100
LABEL EXIT;% 08442000
SUBROUTINE DOIT;% 08443000
BEGIN; STREAM(A~TINU[U]:B);% 08444000
BEGIN SI ~ LOC A; SI ~ SI+5; DS ~ LIT" ";% 08445000
DS ! 3 CHR; DS ~ LIT " "; A ~ DI END;% 08446000
A ~ P; T ~ LABELTABLE[U];% 08447000
IF U LSS 16 THEN TEMP:=PRNTABLE[U].[30:18]; 08447100
IF T=0 THEN 08448000
STREAM(B:=TEMP,V:=(U LSS 16),A); 08448050
BEGIN SI:=LOC V;SI:=SI+7; 08448100
IF SC NEQ "0" THEN BEGIN SI:=LOC B;DS:=5DEC END; 08448110
DS:=9LIT" SCRATCH~" END 08448150
ELSE IF T = @114 OR T = @214 THEN% 08449000
BEGIN 08450000
STREAM(SAV:=((TWO)U) AND SAVEWORD) NEQ 0),A); 08450100
BEGIN 08450200
DS:=10LIT"NOT READY~"; 08450300
SAV(DI:=DI-1; DS:=8LIT"(SAVED)~"); 08450400
END 08450500
END 08450600
ELSE IF ABS(T)=@314 THEN 08451000
STREAM(B:=TEMP,V:=(U LSS 16),A); 08451100
BEGIN SI:=LOC V; SI:=SI+7; 08451200
IF SC NEQ "0" THEN BEGIN SI:=LOC B;DS:=5DEC END; 08451210
DS:=11 LIT " UNLABELED~"; 08452000
END 08452100
ELSE BEGIN;% 08453000
STREAM(K:=T<0: TEMP, V:=U<16, A); 08454000
BEGIN V(SI:=LOC TEMP; DS:=5 DEC; DS:=LIT" "); 08454500
CI:=CI+K; GO TO LAB; 08455000
DS:=6 LIT"IN USE"; GO TO L; 08455500
LAB: DS:=7 LIT"LABELED"; 08456000
L: DS:=LIT" "; K:=DI; 08457000
END; 08458000
A ~ P;% 08459000
IF (NT1 ~ RDCTABLE[U].[8:6]) ! 0 THEN% 08460000
IF JARROW[NT1] ! 0 THEN% 08461000
BEGIN;STREAM(J~JARROW[NT1]:NT1,A);% 08462000
BEGIN DS ~ 3 LIT "BY "; SI ~ J;% 08463000
SI ~ SI+1; DS ~ 7 CHR;% 08464000
DS ~ LIT "/"; SI ~ SI+1;% 08465000
DS ~ 7 CHR; DS ~ LIT "=";% 08466000
SI~LOC NT1; DS~2DEC; 08467000
DS ~ LIT ":"; J ~ DI;% 08468000
DI~DI-3; DS~FILL; 08468500
END;% 08469000
A ~ P;% 08470000
END ELSE ELSE 08471000
IF T<0 AND (U=23 OR U=24) THEN 08471010
BEGIN 08471020
STREAM(S:=0 : A); 08471030
BEGIN 08471040
DS:=22LIT"BY AUTO LOAD CONTROL: "; 08471050
S:=DI; 08471060
END; 08471070
A:=P; 08471080
END ELSE 08471090
IF U GEQ 20 AND U LEQ 22 THEN 08471100
IF LABELTABLE[U].[1:5]=@21 THEN 08471105
BEGIN STREAM(S:=0,A); 08471110
BEGIN 08471120
DS:=13 LIT "BY SCHEDULED "; 08471130
DS:=13 LIT "PRNPBT/DISK: "; 08471140
S:=DI; 08471150
END; 08471160
A:=P; 08471170
END; 08471180
STREAM(S~0:K~MULTITABLE[U],T,R~RDCTABLE[U]. 08472000
[14:10],D~RDCTABLE[U].[24:17],C~RDCTABLE[U].% 08473000
[41:7],A); BEGIN SI ~ LOC K;% 08474000
2(SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT " ");% 08475000
DS ~ 3 DEC; DS ~ LIT " ";% 08476000
DS ~ 5 DEC; DS ~ LIT " ";% 08477000
DS ~ 2 DEC; DS ~ LIT "~";% 08478000
S~DI; 08478500
END; 08478600
A~P; 08478700
IF U}32 THEN IF CIDROW[U -32]!0 THEN 08478800
STREAM(DK~CIDTABLE[U -32,2],A); 08478900
BEGIN 08479000
DI~DI-1; 08479100
$ SET OMIT = NOT(PACKETS) 08479109
DS:=5 LIT ",PKT "; 08479110
$ POP OMIT 08479111
$ SET OMIT = PACKETS 08479199
SI~LOC DK; SI~SI+1; 08479300
DS~7 CHR; 08479400
END; 08479500
END; 08479600
SPOUT(B INX TUSTA); 08480000
B ~ 0;% 08481000
END;% 08482000
TUSTA~M[B.[15:15]-2]; 08482050
IF (U ~ UNITIN(TINU,B)){ PSEUDOMAXT THEN 08483000
BEGIN B ~ B.[15:15]-1;% 08484000
IF (U OR 1)=19 THEN SUSTATUS(B INX TUSTA,0,U) ELSE 08484500
DOIT;% 08485000
GO TO EXIT;% 08486000
END;% 08487000
$ SET OMIT = SHAREDISK 08487099
SCRTOG ~ U = PSEUDOMAXT + 1; 08487100
$ POP OMIT 08487101
$ SET OMIT = NOT(SHAREDISK) 08487199
STREAM(A~0:B);% 08488000
BEGIN SI ~ B;% 08489000
L: IF SC = " " THEN% 08490000
BEGIN SI ~ SI+1; GO TO L END;% 08491000
DI ~ LOC A; DI ~ DI+6; DS ~ 2 CHR;% 08492000
END;% 08493000
Q ~ P; B ~ B.[15:15]-1;% 08494000
FOR U ~ 0 STEP 1 UNTIL PSEUDOMAXT DO 08495000
IF TINU[U].[30:12] = Q THEN% 08496000
IF (G ~ LABELTABLE[U])!0 AND G!@114 AND G!@214 08497000
AND NOT SCRTOG OR G=0 AND SCRTOG THEN 08497100
BEGIN IF B = 0 THEN B ~ SPACE(10);% 08498000
DOIT;% 08499000
END;% 08500000
IF B ! 0 THEN% 08501000
BEGIN;STREAM(Q,R);% 08502000
BEGIN DS ~ 6 LIT " NULL ";% 08503000
SI ~ LOC Q; SI ~ SI+6; DS ~ 2 CHR;% 08504000
DS ~ 7 LIT " TABLE~";% 08505000
END;% 08506000
SPOUT(B INX TUSTA); 08507000
END;% 08508000
EXIT: END;% 08509000
PROCEDURE TIMEUSED(B, X); 08525000
VALUE B, X; 08526000
REAL B, X; 08527000
BEGIN INTEGER T, H, M, S, CPT, IOT, ET; 08528000
$ SET OMIT = NOT(PACKETS) 08528499
DEFINE UNITNO = PSEUDOMIX[X]#; 08528500
$ POP OMIT 08528501
REAL SUBROUTINE CONVERTIME; 08529000
BEGIN S ~ T-60|(T ~ T DIV 60); 08530000
M ~ T-60|(H ~ T DIV 60); 08531000
STREAM(R~0: A~[H]); 08532000
BEGIN DI~LOC R; DI~DI+2; SI~A; 3(DS~2 DEC) END; 08533000
CONVERTIME ~ POLISH 08533100
END; 08533200
T ~ JAR[X,3]+PROCTIME[X]; 08533400
$ SET OMIT = NEWLOGGING 08533499
IF X=P2MIX OR X=P1MIX THEN 08533500
$ POP OMIT 08533501
$ SET OMIT = NOT(NEWLOGGING) 08533599
T ! T+CLOCK+P(RTR); 08533700
T ~ T/60; CPT ~ CONVERTIME; 08534000
T ~ JAR[X,4]+IOTIME[X]; 08535000
WHILE T<0 DO T ~ T+CLOCK+P(RTR); 08536000
T ~ T/60; IOT ~ CONVERTIME; 08537000
T ~ ((CLOCK+P(RTR))/60)-NFO[(X-1)|NDX+2].[1:17]; 08538000
ET ~ CONVERTIME; 08538500
STREAM(J~JARROW[X],X,T~[CPT],B); 08540000
BEGIN DS~10 LIT " TIME FOR "; SI~J; SI~SI+1; DS~7 CHR; 08540100
SI~SI+1; DS~LIT "/"; DS~7 CHR; DS~LIT"="; 08540200
SI~LOC X; DS~2 DEC; X~DI; DI~DI-2; DS~FILL; 08540300
DI~X; DS~8 LIT " IS: CP="; SI~T; SI~SI+2; 08541000
3(DS~LIT ":"; DS~2 CHR); 08542000
X~DI; DI~DI-9; DS~8 FILL; DI~X; 08543000
DS~5 LIT ", IO="; SI~SI+2; 08544000
3(DS~LIT ":"; DS~2 CHR); 08544100
X~DI; DI~DI-9; DS~8 FILL; DI~X; 08544200
DS~3 LIT " IN"; SI~SI+2; 08544300
3(DS~LIT ":"; DS~2 CHR); DS~LIT "~"; 08544400
DI~DI-10; DS~8 FILL 08544500
END; 08544600
SPOUTER(B INX MEMORY[B-1],UNITNO,1); 08544700
COMMENT MESSAGE PRESENTLY 72 CHARACTERS LONG; 08544800
END; 08545000
REAL PROCEDURE ANVIL(IL,Z); VALUE IL,Z; REAL IL,Z;% 08546000
BEGIN REAL B=Z,U=+1;% 08547000
REAL ZZ; 08547050
LABEL EXIT; 08547100
ZZ:=Z; 08547200
NAMEID(U,ZZ); 08547300
NAMEID(U,ZZ); 08547400
IF U="/ " THEN 08547500
BEGIN U:=Z.[15:15]; GO EXIT END ELSE 08547600
IF (U ~ UNITIN(TINU,B)) { PSEUDOMAXT THEN 08548000
BEGIN% 08549000
IF LABELTABLE[U] = @114 OR LABELTABLE[U] = @214 THEN% 08550000
BEGIN 08551000
STREAM(A:=TINU[U],SAV:=((TWO(U) AND SAVEWORD) ! 0 ), 08551100
X:=Z.[15:15]-1); 08551200
BEGIN 08551300
SI:=LOC A; SI:=SI+5; DS:=3CHR; 08552000
DS:=11LIT" NOT READY~"; 08553000
SAV(DI:=DI-1; DS:=8LIT"(SAVED)~"); 08554000
END; 08554100
U ~ PSEUDOMAXT + 1; 08555000
END ELSE 08556000
IF LABELTABLE[U] < 0 THEN% 08557000
BEGIN;STREAM(A~TINU[U],X~Z.[15:15]-1);% 08558000
BEGIN SI ~ LOC A; SI ~ SI+5;% 08559000
DS ~ 3 CHR; DS ~ 8 LIT " IN USE~";% 08560000
END;% 08561000
U ~ PSEUDOMAXT + 1; 08562000
END;% 08563000
IF U { PSEUDOMAXT THEN 08564000
LABELTABLE[U] ~ -(IF IL THEN *P(DUP) ELSE @314);% 08565000
EXIT: END; END; 08566000
PROCEDURE LOGOUT(A); VALUE A; REAL A; 08568000
BEGIN REAL RCW=+0; 08568100
REAL MSCW=-2; 08568125
INTEGER I=RCW+1; 08568150
REAL J=I+1, L=J+1; % L MUST BE LAST DECLARATION. 08568200
LABEL EXIT; 08568300
P(0,0,SPACE(335)); % INITIALIZES L 08568600
IF (J:=DIRECTORYSEARCH("SYSTEM ","LOG ",4))=0 THEN 08568700
BEGIN; 08568800
STREAM(L); 08568900
BEGIN DS:=10 LIT "-NULL LOG~" END; 08569000
GO TO EXIT; 08569100
END; 08569200
IF LOGFREE GTR 0 THEN SLEEP([LOGFREE],-0); 08569300
LOGFREE:=ABS(LOGFREE); 08569400
$ SET OMIT = NOT(SHAREDISK) 08569499
MOVE(30,J INX 0,L); 08569600
M[L+10] ~ GETUSERDISK(-(M[L+8]~M[L+8]+10)); % GET XTRA TEN 08569700
DO BEGIN % TO MAKE COPY 08569800
DISKWAIT (-L-31,300,M[J+10]+I); % SIMPLER 08569900
DISKWAIT ( L+31,300,M[L+10]+I); 08569910
END UNTIL (I~I+10)}M[J+8]; 08569920
LOGFREE ~ M[J+10]; 08570000
J:=J INX 0; 08570300
M[J]:=M[J+2]:=M[J+3]:=0; 08570400
M[J+1]:=M[J+8]|6; 08570500
M[J+4]:="DISKLOG"; 08570600
M[J+5]:=4; 08570700
DISKWAIT(J,30,LOGFREE); 08570800
$ SET OMIT = NOT(SHAREDISK) 08570849
LOGFREE~NABS(LOGFREE); 08570870
P(DIRECTORYSEARCH(-"SYSTEM ","LOG ",14),DEL); 08570880
IF HOLDFREE=0 THEN SLEEP([TOGLE],HOLDMASK); 08571000
LOCKTOG(HOLDMASK); 08571100
DISKWAIT(-J,-30,DIRECTORYTOP); 08571200
I:=(M[J+20].[8:10]+1) MOD 1000; 08571300
M[J+20]:=(*P(DUP))&I[8:38:10]; 08571400
DISKWAIT(J,-30,DIRECTORYTOP); 08571500
UNLOCKTOG(HOLDMASK); 08571600
STREAM(J~[ACTDATE],D~[I]); 08571800
BEGIN SI:=D;DS:=8 DEC;DI:=DI-7;SI:=J; 08571900
SI~SI+2; DS~4 CHR; 08572000
END; 08572300
FORGETSPACE(J); 08572400
M[L+4]:=(*P(DUP))&0[1:43:5]&1[11:47:1]&0[12:44:4]; 08572500
M[L+1]~XCLOCK+P(RTR); 08572510
STREAM(DATE,A~0,B~L+1); 08572520
BEGIN SI~ LOC DATE;DI~LOC A;DS~8 OCT;SI~LOC A; 08572530
SI~SI+5;DI~B;DI~DI+1;DS~3 CHR; END; 08572540
ENTERUSERFILE(-I,"SYSLOG ",L-1); 08572600
STREAM(I,L); 08572700
BEGIN DS:=21 LIT"**** NEW LOG FILE IS ";SI:=LOC I;SI:=SI+1; 08572800
DS:=7 CHR;DS:=8 LIT"/SYSLOG~" ; 08572900
END; 08573000
EXIT: 08573100
SPOUT(L); 08573200
IF A THEN KILL([MSCW]); 08573300
END; 08573400
PROCEDURE SAVETHEUNIT(B); VALUE B; REAL B;% 08575000
BEGIN REAL A=B,T,U,I,M1; 08576000
LABEL AGAIN,EXIT; 08576100
M1:=M[B.[15:15]-2]; 08577000
STREAM(B:); 08577100
BEGIN SI:=B; 08577200
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 08577300
B:=SI; 08577400
END; 08577500
B:=P; 08577600
AGAIN: T:=SPACE(10); 08577700
IF (U:=UNITIN(TINU,A)) GTR 31 THEN 08578000
STREAM(A,T); 08578100
BEGIN DS:=10 LIT"INV KBD SV"; 08578200
SI:=A; DS:=3 CHR; 08578300
DS:=LIT"~"; 08578400
END ELSE 08578500
BEGIN I ~ TWO(U);% 08579000
SLEEP([TOGLE],STATUSMASK); 08580000
IF LABELTABLE[U] } 0 THEN% 08581000
BEGIN LABELTABLE[U] ~ @114;% 08582000
MULTITABLE[U]~RDCTABLE[U]~0; 08582100
RRRMECH ~ RRRMECH OR I;% 08583000
READY ~ READY OR I;% 08584000
SAVEWORD := SAVEWORD OR I; 08584100
I ~ " ";% 08585000
END% 08586000
ELSE BEGIN SAVEWORD ~ SAVEWORD OR I;% 08587000
I ~ " TO BE";% 08588000
END;% 08589000
STREAM(A~TINU[U],I,T);% 08590000
BEGIN DS ~ LIT " ";% 08591000
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR;% 08592000
SI ~ SI+2; DS ~ 6 CHR;% 08593000
DS ~ 7 LIT " SAVED~";% 08594000
END;% 08595000
END;% 08596000
SPOUT(T INX M1); 08597000
STREAM(OK:=0,A:); 08597050
BEGIN SI:=A; 08597100
3(IF SC=" " THEN JUMP OUT; 08597150
IF SC="," THEN JUMP OUT; 08597200
IF SC="~" THEN JUMP OUT OT L3; 08597250
SI:=SI+1); 08597300
L1: IF SC=" " THEN 08597350
L2: BEGIN SI:=SI+1; GO TO L1 END; 08597400
IF SC="," THEN GO TO L2; 08597450
A:=SI; 08597500
IF SC!"~" THEN TALLY:=1; 08597550
L3: OK:=TALLY; 08597600
END; 08597650
A:=P; 08597700
IF P THEN GO AGAIN; 08597750
T:=SPACE(30); %146-08597800
DISKWAIT(-1,30,DIRECTORYTOP-SYSNO); %146-08597810
M[T+29]:=SAVEWORD; %146-08597820
DISKWAIT( T,30,DIRECTORYTOP-SYSNO); %146-08597830
FORGETSPACE(T); %146-08597840
END;% 08598000
BOOLEAN PROCEDURE WHYSLEEP(MASK); VALUE MASK; REAL MASK; 08599000
BEGIN 08600000
REAL A, B; 08601000
IF REPLY[P1MIX]=VWY THEN 08602000
BEGIN 08603000
B:=SPACE(KEYMSGSZ); 08604000
DISKWAIT(-B,KEYMSGSZ,MESSAGETABLE[2].[22:26]); 08604100
STREAM(B,MASK,T:=0,O:=0,D:=0,A:=A:=SPACE(4)); 08605000
BEGIN 08606000
SI:=LOC MASK; 08607000
8(IF SC="0" THEN GO TO NEXT; 08608000
IF SC=VWY THEN 08609000
BEGIN 08610000
DI:=A; DS:=3LIT" DS"; A:=DI; GO TO NEXT; 08611000
END; 08612000
T:=SI; DI:=LOC 0; DI:=DI+7; DS:=CHR; 08613000
SI:=LOC O; DI:=LOC D; DI:=DI+6; DS:=2DEC; 08614000
SI:=B; 08615000
R: SI:=SI+6; DI:=DI-2; 08616000
IF SC="*" THEN % END OF FIRST PART OF TABLE 08617000
BEGIN 08617500
SI:=T; GO TO NEXT; 08618000
END; 08618500
IF 2SC NEQ DC THEN GO TO R; 08619000
SI:=SI-6; DI:=A; DS:=LIT" "; DS:=2CHR; A:=DI; SI:=T; 08619500
NEXT: SI:=SI+1); 08620000
DI:=A; DS:=LIT"~"; 08620500
END STREAM STATEMENT; 08621000
SPOUT(A); 08621500
FORGETSPACE(B); 08621600
END % IF "WY" 08622000
ELSE WHYSLEEP:=TRUE; 08622500
END PROCEDURE WHYSLEEP; 08623000
PROCEDURE CHANGEOPTION(BUFF,RS);% 08624000
VALUE BUFF,RS;REAL BUFF,RS;% 08625000
BEGIN REAL B,T,OP,BUS,MASK,OPTER; 08626000
SLEEP([TOGLE],HOLDMASK); 08627000
LOCKTOG(HOLDMASK); 08628000
BUS ~ BUFF.[15:15]-1; B ~ SPACE(30);% 08629000
DISKIO(T,1-B,-30,DIRECTORYTOP-SYSNO); 08630000
OPTER ~ SPACE(OPTIONSZ); 08630100
DISKWAIT(-OPTER,OPTIONSZ,MESSAGETABLE[0].[22:26]); 08631000
STREAM(BUFF,T~0,OPTER,R~[OP]);% 08632000
BEGIN% 08633000
L0: SI~BUFF; %535-08634000
L1: IF SC=" " THEN BEGIN SI~SI+1; GO TO L1; END; %535-08635000
IF SC<"0" THEN %535-08636000
IF SC!"~" THEN %535-08637000
BEGIN TALLY~0; T~TALLY; DI~LOC T; %535-08638000
8(IF SC=" " THEN JUMP OUT ELSE %535-08639000
IF SC="~" THEN JUMP OUT ELSE %535-08640000
IF SC}"0" THEN JUMP OUT ELSE DS ~CHR); %535-08641000
BUFF~SI; SI~OPTER; %535-08642000
63(DI~LOC T; %535-08643000
IF 8 SC=DC THEDN JUMP OUT TO L2 ELSE %535-08644000
IF SC="~" THEN JUMP OUT TO L0 ELSE TALLY~TALLY+1);08645000
GO TO L3; %535-08646000
L2: IF SC="~" THEN GO TO L0; %535-08647000
END ELSE %535-08648000
L3: TALLY~48 ELSE %535-08649000
BEGIN DI~LOC T; SI~SI+1; %535-08650000
IF SC<"0" THEN BEGIN SI~SI-1; DS~1 OCT; END %535-08651000
ELSE BEGIN SI~SI-1; DS~2 OCT; END; %535-08652000
TALLY~47; T(TALLY~TALLY+63); %535-08653000
END; %535-08654000
T~TALLY; SI~LOC T; DI~R; DS~WDS; %535-08655000
END;% 08657000
IF OP<47 THEN 08658000
BEGIN;STREAM(A ~ IF RS THEN " RESET" ELSE " SET",% 08659000
O~OPTER INX OP,OP ~ 47-OP,BUS);% 08660000
BEGIN DS ~ LIT " "; SI ~ LOC OP; DS ~ 2 DEC;% 08661000
DS ~ LIT " "; SI ~ O;% 08662000
8(IF SC=0 THEN JUMP OUT TO L; DS~CHR);% 08663000
L: SI ~ LOC A; SI ~ SI+2; DS ~ 6 CHR;% 08664000
DS ~ LIT"~";% 08665000
END;% 08666000
MASK~TWO(OP);% 08667000
M[BUS-1].[9:9]:=0; 08667100
END;% 08668000
SPOUT(BUS INX M[BUS-1]); 08669000
SLEEP([T],IOMASK); 08670000
M[B]~OPTION~IF RS THEN OPTION AND NOT MASK ELSE OPTION OR MASK;08671000
DISKWAIT(B,-30,DIRECTORYTOP-SYSNO); 08673000
FORGETSPACE(OPTER);% 08674000
FORGETSPACE(B);% 08676000
UNLOCKTOG(HOLDMASK); 08677000
END;% 08678000
PROCEDURE TYPOP(KTR,PO); VALUE KTR,PO; REAL KTR,PO; 08679000
BEGIN REAL VASE,TUSTA,N,X,OPTER; 08680000
LABEL INCR; 08680500
REAL SUBROUTINE SETT; 08681000
BEGIN 08681100
STREAM(OPT:=[OPTION]:OPTER,N,NBS:=47-N,VASE); 08681200
BEGIN 08681300
DI:=DI+4; 08682000
SI~OPTER;N(SI~SI+8);IF SC="~" THEN GO TO EXIT;% 08683000
8(IF SC<"0" THEN DS~CHR ELSE DS~1 LIT" ");DS~2 LIT" ";% 08684000
SI:=OPT; SKIP NBS SB; 08684500
IF SB THEN TALLY:=1 ELSE 08685000
BEGIN DS:=3 LIT"NOT"; TALLY:=2; END; 08685500
DS~5 LIT" SET~";% 08686000
DI:=VASE; SI:=LOC NBS; DS:=LIT" "; DS:=2 DEC; DS:=LIT" "; 08686500
EXIT: OPT:=TALLY; 08687000
END; 08688000
SETT~P; 08689000
END SETT; 08689100
% 08689110
SLEEP([TOGLE],HOLDMASK); 08689200
LOCKTOG(HOLDMASK); 08689300
TUSTA:=M[(VASE:=KTR.[15:15]-1)-1]; 08689900
OPTER ~ SPACE(OPTIONSZ)&OPTIONSZ[8:38:10]; 08690000
DISKWAIT(-OPTER,OPTIONSZ,MESSAGETABLE[0].[22:26]); 08690020
IF PO THEN 08690080
BEGIN 08690090
STREAM(BUFF:=KTR, T:=0, OPTER, D:=[N]); 08690100
BEGIN SI~BUFF;63(IF SC=" " THEN SI~SI+1 ELSE JUMP OUT TO L);L: 08690110
IF SC GEQ "0" THEN GO TO L4; 08690120
DI~LOC T; 08690130
8(IF SC=" " THEN JUMP OUT TO L1 ELSE 08690140
IF SC="~" THEN JUMP OUT TO L1 ELSE 08690150
IF SC}"0" THEN JUMP OUT TO L1 ELSE 08690160
DS~1 CHR); L1: 08690170
TALLY~0; BUFF~SI; SI~OPTER; 08690180
63(DI~LOC T;IF 8 SC!DC THEN 08690190
BEGIN IF SC="~" THEN 08690200
BEGIN TALLY~48; JUMP OUT TO L3 END 08690210
ELSE TALLY~TALLY+1; 08690220
END ELSE JUMP OUT TO L2); TALLY~48;GO TO L3;L2: 08690230
IF SC="~" THEN BEGIN SI~BUFF;63(IF SC<"0" THEN SI~SI+1 08690240
ELSE JUMP OUT TO L4); L4: DI~LOC T; SI~SI+1; 08690250
IF SC<"0" THEN BEGIN SI~SI-1; SI~1 OCT END ELSE 08690260
BEGIN SI~SI-1; DS~2 OCT END; 08690270
TALLY~47; T(TALLY~TALLY+63); 08690280
END; 08690290
L3: T~TALLY; SI~LOC T; DI~D; DS~ WDS; 08690300
END; 08690310
IF N LSS OPTER.[8:10] THEN P(SETT,DEL); 08690400
SPOUT(VASE INX TUSTA); 08690600
END ELSE 08690800
BEGIN 08691000
STREAM(KTR:); 08691200
BEGIN SI:=KTR; 08691400
IF SC="S" THEN TALLY:=1 ELSE 08691600
IF SC="R" THEN TALLY:=2 ELSE TALLY:=3; 08691800
KTR:=TALLY; 08692000
END; 08692200
X:=P; N:=-1; 08692400
INCR: N:=N+1; 08692600
IF ((KTR:=SETT) AND X) ! 0 THEN 08692800
BEGIN SPOUT(VASE INX TUSTA); 08693000
VASE:=SPACE(3); 08693200
GO TO INCR; 08693400
END; 08693600
IF KTR=0 THEN 08693800
IF X!3 THEN 08694000
BEGIN STREAM(X:=X=1, VASE); 08694200
BEGIN DS:=12 LIT" ALL OTHERS "; 08694400
X(DS:=4 LIT"NOT "); 08694600
DS:=4 LIT"SET~"; 08694800
END; 08695000
SPOUT(VASE INX TUSTA); 08695200
END ELSE FORGETSPACE(VASE); 08695400
ELSE GO TO INCR; 08695600
END; 08695800
FORGETSPACE(OPTER);% 08696000
UNLOCK(HOLDMASK); 08696100
END;% 08697000
$ SET OMIT = NOT(DISKLOG) 08697099
% THE FOLLOWING THREE DEFINES MUST EACH BE CHANGED IF THE 08699000
% DISK ROW SIZE OF PBD AND PUD FILES IS TO BE CHANGED. 08699050
DEFINE PBDROWSZ = 08699100
300# % %732-08699150
% PBDROWSZ IS THE DISK ROW SIZE, IN SEGMENTS, OF PBD AND 08699200
% PUD FILES. PBDROWSZ MUST BE A MULTIPLE OF THREE. 08699250
,PBDRECS = 08699300
100# % %732-08699350
% PBDRECS=PBDROWSZ/3 : NO. OF LOGICAL RECORDS PER ROW. 08699400
,PBDTOTRECS = 08699450
2000# % %732-08699500
;% PBDTOTRECS=PBDRECS|20 : NO. OF TOTAL RECORDS PER BACK-UP FILE. 08699550
PROCEDURE PBIO(ALPHA,POINTER); VALUE ALPHA; REAL ALPHA,POINTER; %P 08700000
% 08700900
% THIS PROCEDURE HANDLES IO FOR THE CREATION OF BACK-UP FILES. FOR 08700910
% DISK, IT OBTAINS NEW ROWS AND NEW FILES AS NECESSARY. IF IT RUNS 08700920
% OUT OF FILES, HEADER[5].[4:1] IS SET AND THE JOB TERMINATED, LEAVING08700930
% ONE BLOCK FOR THE LABEL AND DS MESSAGE. 08700940
% 08700950
% ALPHA IS ADDRESS OF TOP I/O DESCRIPTOR. <0 MEANS READ %P 08701000
% POINTER IS FIB[14] %P 08702000
BEGIN NAME HEADER; 08703000
REAL T=-2,IOD,H,S; 08704000
INTEGER I=IOD; 08704100
LABEL OK; 08704500
POINTER.[FF]~POINTER INX 72; %P 08705000
IF (HEADER~POINTER.[3:15])!0 THEN %%%%PB ON DISK %%%%% %P 08706000
BEGIN 08707000
HEADER := [M[(*HEADER)]]; 08707500
IF HEADER[7] GEQ PBDTOTRECS-2 THEN % CHECK FOR NEW FILE 08708000
BEGIN 08708200
$ SET OMIT = PACKETS 08708400
IF HEADER[6].[42:6]="9" THEN 08709000
$ POP OMIT OMIT 08709200
IF HEADER[7] GEQ PBDTOTRECS THEN P(XIT) ELSE 08709400
IF HEADER[5].[4:1] THEN GO TO OK ELSE 08709500
BEGIN STREAM(F:=PRT[P1MIX,3] INX M[M[ALPHA-3] INX 4].08709600
[13:11], H:=H:=NABS(SPACE(12))); 08709800
BEGIN SI:=F; SI:=SI+1; 08710000
DS:=24 LIT"TOO MANY BACKUP RECS ON "; 08710200
DS:=7 CHR; DS:=LIT"/"; SI:=SI+1; DS:=7 CHR;08710400
DS:=2 LIT":~"; 08710600
END; 08710800
HEADER[5].[4:1]:=1; 08711000
GO TO OK; 08711200
END; 08711400
IF HEADER[7] GEQ PBDTOTRECS THEN % GET A NEW FILE 08711600
BEGIN 08711800
IF I:=HEADER[5].[3:1] THEN HEADER[5].[3:1]:=0; 08712000
H~SPACE(30); S~M[HEADER INX NOT 0]; 08712100
DISKWAIT(-H,30,S); 08712110
M[H+7]~HEADER[7]; 08712120
M[H+5].[2:1]~0; 08712130
DISKWAIT(H,30,S); 08712140
M[H+7]~M[H+9]~0; 08712150
MOVE(20,H+9,H+10); 08712160
M[H+5]~(*P(DUP)) OR H; 08712170
HEADER[5].[3:1]:=1; %SET CP BK UP TOG 08712200
HEADER[7] := 0; 08712500
HEADER[3] := XCLOCK + P(RTR); 08713000
STREAM(ONE:=1, H:=[HEADER[6]]); 08713250
BEGIN SI:=LOC ONE; DS:=8 ADD; 08713500
DI:=DI+24; 20(DS:=8 LIT"0"); 08713750
END; 08714000
M[H+7]~PBDROWSZ DIV 3; 08714110
HEADER[9]~M[H+9]~1; 08714120
HEADER[10]~M[H+10]~GETUSERDISK(-(PBDROWSZ+1)); 08714130
M[HEADER INX NOT 0] := EUF(-(IF I THEN "PUD " 08714140
ELSE "PBD "),HEADER[6],H-1); 08714150
FORGETSPACE(H); 08714170
$ SET OMIT = PACKETS 08714199
FILEMESSAGE((IF I THEN "PUD " ELSE 08714300
"PBD ")&HEADER[6][24:6:24], 08714310
"OUT " &HEADER[6][30:30:18], 08714320
0," ",0,0,0, 08714330
(PBDREL OR OPNMESS)); 08714340
END; 08714400
END ELSE 08714500
IF HEADER[7] MOD PBDRECS=0 THEN %GET NEW ROW 08715000
BEGIN H:=SPACE(30); S:=M[HEADER INX NOT 0]; 08715100
DISKWAIT(-H,30,S); 08715200
HEADER[9+HEADER[9]~*P(DUP)+1]~ 08716000
GETUSERDISK(-(PBDROWSZ+1)); 08716010
M[H+9+HEADER[9]]~HEADER[9+HEADER[9]]; 08716100
M[H+9]~HEADER[9]; 08716110
M[H+7]~HEADER[7] + PBDROWSZ DIV 3; 08716200
DISKWAIT(H,30,S); 08716300
FORGETSPACE(H); 08716500
END; 08716600
OK: 08716800
STREAM(A~1~HEADER[HEADER[9]+9]+(HEADER[7] MOD 08717000
PBDRECS)|3,D~POINTER.[CF]-1); 08718000
BEGIN SI~LOC A; DS~8 DEC END; %P 08720000
HEADER[7]~(*P(DUP))+1; %P 08721000
IOD~@141330100477777; 08722000
END ELSE %% ON TAPE %% %P 08723000
IOD~@21320500000000&M[POINTER INX NOT 1][3:14:4]; %P 08724000
IOREQUEST(M[ALPHA],POINTER INX IOD&ALPHA[24:1:1], %P 08726000
M[POINTER INX NOT 1]); 08727000
M[T]~IOD INX M[T]$0[26:26:7]&0[19:19:1] AND NOT M; 08728000
IF H LSS 0 THEN 08728500
BEGIN TERMINATE(P1MIX); 08728600
TERMINALMESSAGE(H); 08728700
END; 08728800
END PBIO; 08729000
PROCEDURE TIMERELAXER(KTR,TYPE,MIX);% 08730000
VALUE KTR,TYPE,MIX;% 08731000
REAL KTR,TYPE,MIX;% 08732000
BEGIN INTEGER BUFF,PRT,IOT,T,P1,I1;% 08733000
LABEL SPIT;% 08734000
DEFINE VCT = 29#, % CHANGE TIME LIMITS 08734010
VXT = 30#, % EXTEND TIME LIMITS 08734020
VTL = 31#; % PRINT TIME LIMITS 08734030
COMMENT: THIS ROUTINE SHOULD BE BLAMED ON WWF4;% 08734100
$ SET OMIT = NOT(PACKETS) 08734499
DEFINE UNITNO = PSEUDOMIX[MIX]#;% 08734500
$ POP OMIT 08734501
BUFF ~ KTR.[15:15]-1;% 08735000
IF TYPE NEQ VTL THEN BEGIN; 08736000
STREAM(IOT~0,PRT~0,CODE~0: KTR);% 08737000
BEGIN SI~KTR; IF SC=" " THEN BEGIN L1: SI~SI+1;% 08738000
IF SC=" " THEN GO L1; END; %534-08739000
IF SC="*" THEN BEGIN SI~SI+1; GO L5; END; %534-08739500
IF SC="," THEN GO L2; IF SC<"0" THEN GO EXIT;% 08740000
KTR~SI; L3: TALLY~TALLY+1; SI~SI+1; 08741000
IF SC}"0" THEN GO L3; SI~KTR; CODE~TALLY; 08742000
DI~LOC PRT; DS~CODE OCT; TALLY~0;% 08743000
L5: IF SC=" " THEN BEGIN L4: SI~SI+1;% 08744000
IF SC=" " THEN GO L4 END; IF SC="," THEN GO L2;% 08745000
IF SC="~" THEN TALLY~1; GO EXIT;% 08746000
L2: SI~SI+1; IF SC=" " THEN BEGIN L6: SI~SI+1;% 08747000
IF SC=" " THEN GO L6 END ; KTR~SI;% 08748000
IF SC="*" THEN BEGIN TALLY~1; GO EXIT END;% 08749000
IF SC="~" THEN BEGIN TALLY~1; GO EXIT; END; %534-08749500
IF SC<"0" THEN GO EXIT; L7: TALLY~TALLY+1;% 08750000
SI~SI+1; IF SC}"0" THEN GO L7; DI~ LOC IOT;% 08751000
SI~KTR; CODE~TALLY; DS~CODE OCT; TALLY~1;% 08752000
EXIT: CODE~TALLY;% 08753000
END STREAM;% 08754000
IF NOT P THEN GO SPIT;% 08755000
PRT ~ P|3600; IOT ~ P|3600;% 08756000
IF TYPE=VXT THEN BEGIN 08757000
IF PRT!0 THEN BEGIN% 08758000
PROCTIME[MIX] ~ *P(DUP)-PRT;% 08759000
JAR[MIX,3] ~ *P(DUP)+PRT;% 08760000
END;% 08761000
IF IOT!0 THEN BEGIN% 08762000
IOTIME[MIX] ~ *P(DUP)-IOT;% 08763000
JAR[MIX,4] ~ *P(DUP)+IOT;% 08764000
END END ELSE BEGIN% 08765000
IF PRT!0 THEN BEGIN% 08766000
PROCTIME[MIX] ~ *P(DUP)+JAR[MIX,3]-PRT;% 08767000
JAR[MIX,3] ~ PRT;% 08768000
END;% 08769000
IF IOT!0 THEN BEGIN% 08770000
IOTIME[MIX] ~ *P(DUP)+JAR[MIX,4]-IOT; 08771000
JAR[MIX,4] ~ IOT;% 08772000
END END; 08773000
STREAM(TEST~0: X~JARROW[MIX],MIX,Z~PRT!0,I~IOT!0,% 08774000
K:=TYPE=VXT,T:=T:=SPACE(10)); 08775000
BEGIN DS~LIT " "; Z(DS~4 LIT "PRT "; TALLY~1;% 08776000
I(DS~4 LIT"AND ")); I(DS~4 LIT "IOT "; TALLY~1);% 08777000
DS~8 LIT "ESTIMATE"; Z(I(DS~LIT "S"));% 08778000
DS~8LIT" CHANGED"; K(DI~DI-7; DS~8LIT"EXTENDED"0;% 08779000
DS~5LIT" FOR"; SI~S; SI~SI+1; DS~7CHR; SI~SI+1;% 08780000
DS~LIT"/"; DS~7CHR; DS~LIT"="; SI~LOC Z;% 08781000
SI~SI-8; DS~2DEC; DS~LIT"~"; TEST~TALLY; 08782000
DI~DI-3; DS~FILL; 08782500
END STREAM;% 08783000
IF P THEN SPOUTER(T INX M[BUFF-1],UNITNO,1) ELSE 08784000
FORGETSPACE(T); 08784100
END; 08785000
IOT ~ PRT ~ -0;% 08786000
IF P(JAR[MIX,3],DUP)=@377777777777 THEN P(DEL)ELSE% 08787000
P1 ~ (PRT ~ P DIV 3600)-60|(PRT ~ PRT DIV 60);% 08788000
IF P(JAR[MIX,4],DUP)=@377777777777 THEN P(DEL) ELSE% 08789000
I1 ~ (IOT ~ P DIV 3600)-60|(IOT ~ IOT DIV 60);% 08790000
STREAM(X~JARROW[MIX], MIX,PRT,P1,IOT,I1,BUFF); 08791000
BEGIN DS~17LIT" TIME LIMITS FOR"; SI~X; SI~SI+1; DS~7CHR;% 08792000
DS~LIT"/"; SI~SI+1; DS~7CHR; DS~LIT"="; DI~LOC MIX; 08793000
DS~2DEC; MIX~DI; DI~DI-2; DS~FILL; DI~MIX; 08793500
DS~10LIT" ARE: PRT="; IF SC="+" THEN 08794000
BEGIN SI~SI+16; DS~8LIT"NO LIMIT" END ELSE BEGIN% 08795000
DS~8DEC; DS~LIT":"; DS~2DEC; BUFF~DI; DI~DI-11;% 08795500
DS~7FILL; DI~BUFF END; DS~6LIT"; IOT="; IF SC="+" THEN 08796000
DS~10LIT"NO LIMIT.~" ELSE BEGIN DS~8DEC; DS~LIT":";% 08796500
DS~2DEC; DS~2LIT".~"; DI~DI-13; DS~7FILL END; 08797000
END STREAM;% 08797500
SPIT:% 08798000
SPOUTER(BUFF INX M[BUFF-1],UNITNO,1); 08798500
END TIMERELAXER; 08799000
PROCEDURE CHANGEFACTOR(BUFF,TF); VALUE BUFF,TF; REAL BUFF; BOOLEAN TF; 08800000
BEGIN REAL FACTOR,B,T; INTEGER TEMP=T; 08801000
LABEL TYPEOUT,EXIT; 08802000
BUFF ~ ((B~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 08802500
IF TF THEN GO TYPEOUT; 08803000
STREAM(ANS~0:B); 08804000
BEGIN SI~B; DI~LOC B; DS~8LIT"00000000:; DI~DI-2; 08805000
L: IF SC = " " THEN BEGIN SI~SI+1; GO TO L END; 08806000
IF SC < "0" THEN GO TO L1; 08807000
IF SC > "9" THEN GO TO L1; 08808000
SI~SI+1; 08809000
IF SC < "0" THEN GO TO ONECHR; 08810000
IF SC { "9" 08810500
THEN BEGIN SI~SI-1; DI~DI-2; DS~2 CHR; END 08811000
ELSE ONECHR: BEGIN SI~SI-1; DI~DI-1; DS~1 CHR; END; 08812000
IF SC = "." THEN GO TO L2 ELSE GO TO L3; 08813000
L1: IF SC ! "." THEN GO TO ERROR; 08814000
L2: SI~SI+1; 08815000
IF SC < "0" THEN GO TO ERROR; 08816000
IF SC > "0" THEN GO TO ERROR; 08817000
DS~CHR; 08818000
IF SC } "0" THEN IF SC { "9" THEN DS~CHR; 08819000
L3: IF SC = " " THEN GO CONVERT; 08820000
IF SC = "~" THEN GO CONVERT; 08821000
ERROR:DI~LOC ANS; SKIP 1 DB; DS~ 10 SET; GO TO EXITS; 08822000
CONVERT: SI~LOC B; SI~SI+4; DI~LOC ANS; DS~4 OCT; 08823000
EXITS: 08824000
END STREAM; 08825000
P(.FACTOR,~); 08826000
IF FACTOR < 0 THEN GO TO EXIT; 08828000
CORE.[4:14] ~ FACTOR; 08829000
SLEEP([TOGLE],HOLDMASK); LOCKTOG(HOLDMASK); 08830000
B ~ SPACE(30); 08831000
DISKWAIT(-B,30,DIRECTORYTOP-SYSNO); 08832000
M[B+9] ~ CORE; % CHANGE FACTOR 08833000
DISKWAIT(B,-30,DIRECTORYTOP-SYSNO); 08834000
FORGETSPACE(B); 08835000
UNLOCKTOG(HOLDMASK); 08836000
SELECTION; 08836500
TYPEOUT: 08837000
STREAM(I~(FACTOR~CORE.[4:14]) DIV 100, FR~(TEMP~FACTOR MOD 100), 08838000
MX~(TEMP~CORE.[CF]|64|FCTOR/100),US~CORE.[FF]|64, %749-08839000
$ SET OMIT = NOT WORKSET %749-08839499
NOSELECT~WKSETNOSELECT, %749-08839500
$ POP OMIT %749-08839501
BUFF); %749-08839600
BEGIN DS~9 LIT"FACTOR = "; 08840000
SI~LOC I; DS~2 DEC; I~DI; DI~DI-2; DS~FILL; DI~I; 08841000
DS~LIT"."; DS~2 DEC; 08842000
DS~13 LIT", MAX CORE = "; DS~7 DEC; 08843000
I~DI; DI~DI-7; DS~6 FILL; DI~I; 08844000
DS~7LIT",USING "; DS~7 DEC; I~DI; DI~DI-7; DS~6 FILL;%749-08845000
DI:=I; %749-08845500
$ SET OMIT = NOT WORKSET %749-08845999
NOSELECT(DS:=14 LIT ",WKSETNOSELECT"); %749-08846000
$ POP OMIT %749-08846001
DS:=LIT"~"; %749-08846010
END STREAM; 08847000
EXIT: SPOUT(BUFF); 08848000
END CHANGEFACTOR; 08849000
PROCEDURE SHEETDIDDLER(BUFF,TYPE,STD); VALUE BUFF,TYPE,SID; 08850000
REAL BUFF,TYPE,SID; 08850100
COMMENT TYPE = 6: PS -- CHANGE PRIORITY OF JOB IN SCHEDULE 08850200
= 8: XS -- EXECUTE JOB IN SCHEDULE (FORCE SELECTION) 08850300
= 7: ES -- ELIMINATE JOB FROM SCHEDULE (FORCE SELECTION, 08850400
THEN "DS") 08850500
= 5: TS -- TYPE OUT SCHEDULE; 08850600
BEGIN REAL IOD,T,PRIORITY; 08851000
INTEGER LEVEL,NEXTLINK,THISLINK,LASTLINK; 08852000
INTEGER ES,EM,EH; DEFINE ET = EH#; 08852500
$ SET OMIT = NOT(DATACOM ) 08852599
BOOLEAN LASTPASED,ATLEASTONE; 08853000
ARRAY S[*],DLNK[*]; 08854000
$ SET OMIT = NOT(PACKETS) 08854499
DEFINE UNITNO = S[23].[2:6]#; % ORIGINATING UNIT 08854500
$ POP OMIT 08854501
LABEL CONTINUE,C1,READIN,GNX,TS,TS1,TS2, 08855000
XSES,ESLL,PS,PS1,PS2,SPIT,EXIT; 08856000
SUBROUTINE GETNEXT; % READS IN NEXT JOB SHEET ENTRY 08858000
BEGIN 08859000
CONTINUE: LASTLINK ~ THISLINK; 08860000
IF (THISLINK~NEXTLINK) ! 0 THEN GO TO READIN; 08860500
C1: IF (LEVEL~LEVEL+1) > MIXMAX THEN 08861000
BEGIN LASTPASSED ~ TRUE; GO TO GNX END; 08862000
LASTLINK ~ NEXTLINK ~ 0; 08863000
IF (THISLINK~SHEET[LEVEL].[CF]) = 0 THEN GO TO C1; 08864000
READIN: DISKIO(IOD,-(S INX 0-1),30,THISLINK); 08865000
SLEEP([IOD],IOMASK); 08866000
NEXTLINK ~ S[29]; 08867000
IF S[0].[36:6]=@14 THEN GO CONTINUE;%PASS LM ENTRY 08868000
GNX: 08869000
END GETNEXT; 08870000
SLEEP([TOGLE],SHEETMASK); LOCKTOG(SHEETMASK); 08880000
S := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-08881000
LEVEL ~ -1; LASTPASSED ~ FALSE; 08882000
IF BUFF!0 THEN 08882050
BUFF ~ ((T~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 08882500
$ SET OMIT = NOT(DATACOM ) 08882599
IF TYPE=5 THEN GO TS; IF TYPE GTR 6 THEN GO XSES; GO PS; 08883000
IS: ATLEASTONE ~ FALSE; 08884000
IS1: GETNEXT; IF LASTPASSED THEN GO TO TS2; 08885000
IF SID NEQ 63 THEN BEGIN IF S[3].[8:10]NEQ SID THEN GO TS; END ELSE 08885500
IF ATLEASTONE THEN BUFF.[CF]~SPACE(12); 08886000
ET~((CLOCK+P(RTR))/60)-S[23].[24:24]; 08886300
ES ~ ET MOD 60; ET ~ ET DIV 60; EM ~ ET MOD 60; EH ~ ET DIV 60; 08886600
STREAM(TU~S[23].[9:4],BUF~S[23].[14:4], 08887000
RT:=S[23].[9:4] NEQ 0,C:=LEVEL,J1:=(S[0] LSS 0) OR 08887001
(S[2].SSYSJOBF = LIBMAINCODE),J2:=S[27], 08887010
J~S[*],ID~S[3].[8:10],EH,EM,ES,A~S[20]|64,BUFF); % 08887100
BEGIN SI~LOC C; DS~6 DEC; DI~DI-6; DS~5 FILL; DI~BUFF; DI~DI+6; 08888000
DS~LIT":"; SI~J; SI~SI+1; DS~7 CHR; DS~LIT"/"; SI~SI+1; 08889000
DS:=7CHR;J1(DS:=LIT" ";SI:=LOC J2;SI:=SI+1;DS:=7CHR); 08890000
DS:=LIT"=";SI:=LOC ID;DS:=2 DEC; 08890010
RT(DS~6 LIT " FROM "; SI~LOC TU; DS~2 DEC; % 08890100
DS~1 LIT "/"; SI~LOC BUF; DS~2 DEC;); % 08890200
DS~7 LIT" IN FOR"; SI~LOC EM; 08891000
3(DS ~ LIT":"; DS~2 DEC); ES~DI; DI~DI-9; DS~8 FILL; 08892000
DI~ES; DS~8 LIT", NEEDS "; 08893000
SI~LOC A; DS~5 DEC; DS~LIT"~"; DI~DI-6; DS~4 FILL; 08899000
END STREAM; 08900000
SPOUTER(BUFF,IF SID!63 THEN UNITNO ELSE 0,1); 08901000
IF SID NEQ 63 THEN BEGIN TYPE:=5;GO EXIT END; 08901500
ATLEASTONE~TRUE; 08902000
GO TO TS; 08903000
TS2: IF ATLEASTONE THEN GO TO EXIT; 08904000
IF SID NEQ 63 THEN YTPE:=5 ELSE% 08904050
STREAM(BUFF); DS ~ 15 LIT " NULL SCHEDULE~";% %WF 08905000
SPOUT(BUFF); GO TO EXIT; 08906000
XSES: GETNEXT; 08910000
IF LASTPASSED THEN BEGIN IF BUFF!0 THEN SPOUT(BUFF); 08911000
GO TO EXIT; END; 08911050
IF S[3].[8:10]~SID THEN GO TO XSES; 08912000
$ SET OMIT = NOT(DATACOM ) 08912099
S[2].[1:2]:=(IF TYPE=8 THEN 2 ELSE 3); % 7=ES,8=XS 08913000
DISKIO(IOD,S INX 0-1,30,THISLINK); SLEEP([IOD],IOMASK); 08915000
GO TO SPIT; 08915100
PS: STREAM(PRIORITY:T); 08916000
BEGIN SI~T; 08917000
N: IF SC="~" THEN GO TO X; 08918000
IF SC<"0" THEN BEGIN SI~SI+1; GO TO N; END; T~SI; 08919000
K: IF SC}"0" THEN IF SC{"9" THEN 08920000
BEGIN TALLY~TALLY+1; SI~SI+1; GO TO K END; 08921000
SI~T; DI~LOC PRIORITY; T~TALLY; DS~T OCT; GO TO Z; 08922000
X: DI~LOC PRIORITY; SKIP DB; DS~11 SET; 08923000
Z: 08924000
END STREAM; 08925000
IF (PRIORITY~P)<0 THEN BEGIN SPOUT(BUFF); GO TO EXIT END; 08926000
PS1: GETNEXT; IF LASTPASSED THEN BEGIN SPOUT(BUFF); GO TO EXIT END; 08927000
IF S[3].[8:10]!SID THEN GO TO PS1; 08928000
% DELINK AND RELINK THIS SHEET ENTRY 08929000
DLNK := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-08930000
IF NEXTLINK = 0 THEN SHEET[LEVEL].[FF] ~ LASTLINK; 08931000
IF LASTLINK = 0 THEN BEGIN SHEET[LEVEL].[CF]~ NEXTLINK;GO PS2 END;08932000
DISKIO(IOD,-(DLNK INX 0-1),30,LASTLINK); SLEEP([IOD],IOMASK); 08933000
DLNK[29] ~ NEXTLINK; 08934000
DISKIO(IOD,+(DLNK INX 0-1),30,LASTLINK); SLEEP([IOD],IOMASK); 08935000
PS2: S[2].[CF] ~ IF (S[18]~PRIORITY) > 32767 THEN 32767 ELSE PRIORITY; 08936000
LEVEL ~ IF PRIORITY > MIXMAX THEN MIXMAX ELSE PRIORITY; 08937000
IF SHEET[LEVEL].[CF] ~ 0 THEN 08938000
BEGIN DISKIO(IOD,-(DLNK INX 0-1),30,SHEET[LEVEL].[FF]); 08939000
SLEEP([IOD],IOMASK); 08940000
DLNK[29] ~ THISLINK; 08941000
DISKIO(IOD,+(DLNK INX 0-1),30,SHEET[LEVEL].[FF]); 08942000
SLEEP([IOD],IOMASK); 08943000
END ELSE SHEET[LEVEL] ~ THISLINK; 08944000
SHEET[LEVEL].[FF] ~ THISLINK; 08944500
S[29] ~ 0; S[3] ~ ABS(S[3]); % TO GET SELECTION TO PRINT MESSAGE; 08945000
DISKIO(IOD,+(S INX 0-1),30,THISLINK); SLEEP([IOD],IOMASK); 08946000
FORGETSPACE(DLNK); 08947000
SPIT: IF BUFF!0 THEN 08947100
$ SET OMIT = NOT(PACKETS) 08947199
IF UNITNO GEQ 32 THEN 08947200
BEGIN 08947300
MOVE(9,BUFF+1,BUFF); SPOUTER(BUFF,UNITNO,64); 08947400
END ELSE 08947500
$ POP OMIT 08947501
FORGETSPACE(BUFF); 08947600
EXIT: UNLOCKTOG(SHEETMASK); 08997000
FORGETSPACE(S); 08998000
IF TYPE!5 THEN BEGIN KEYBOARDCOUNTER ~ KEYBOARDCOUNTER-1; 08998200
SELECTION; 08998400
KEYBOARDCOUNTER ~ KEYBOARDCOUNTER+1; 08998600
END; 08998800
END SHEETDIDDLER; 08999000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 08999999
$ SET OMIT = NOT(DISKLOG) 09299999
PROCEDURE WHATINTRNSIC(BUFF); VALUE BUFF; REAL BUFF; FORWARD; 09400000
$ SET OMIT = NOT(AUXMEM) 09400099
$ SET OMIT = NOT MONITOR 09410100
$ SET OMIT = NOT AUXMEM 09433590
PROCEDURE INTRINSICTABLEBUILDER(FH); VALUE FH; REAL FH; 09500000
BEGIN 09500500
% WHEN CALLED WITH FH= (-1), TRANSFER TO AUXMEM ONLY 09500510
REAL DISKADDR=+1,T=+2,INTLOC=+3,T17SIZE=+4,MAXINT=+5; 09501000
$ SET OMIT = NOT(AUXMEM) 09501500
P(0, 0, 0, 0, 0); 09504570
IF (T:=FH.[FF])=0 THEN T:=SPACE(30); 09505000
$ SET OMIT = NOT(AUXMEM) 09505100
DISKWAIT(-T, 30, DISKADDR:=M[FH INX 10]); 09505500
MAXINT := M[T] ~ 1; % NUMBER OF INTRINSICS + 1 09505600
T17SIZE := M[T INX 17].[8:10]+1; % INTR.#17 SIZE+1WD.FOR DISK.ADDR. 09505700
FORGETSPACE(T); 09505750
INTRNSC:=[M[INTLOC:=GETSPACE(MAXINT+I17SIZE,INTARRAYAREAV,1)+2]]& 09506000
(MAXINT+T17SIZE)[8:38:10]; % SPACE FOR INTRINSIC TABLE + INT.#17 09506100
DISKWAIT(-(INTRNSC INX 0),MAXINT,DISKADDR); 09506500
M[INTRNSC INX NOT 0] := 0; MAXINT := MAXINT -1; 09507000
FOR T := 1 STEP 1 UNTIL MAXINT DO 09507500
INTRNSC[T]:=NABS(([(*P(DUP),DUP).[8:10]+INTSIZE) & 09508000
(P(XCH) INX 0 + DISKADDR)[6:21:27]); 09508500
DISKWAIT(-(INTLOC:=INTLOC+MAXINT+2),(T17SIZE-1),INTRNSC[17].[6:27]); 09508600
INTRNSC[17] := (*P(DUP))&INTLOC[CTC]; % MARK PERCENT 09508700
M[INTLOC-1]:=0&(T17SIZE-1)[CTF]; % DUMMY MARKER FOR DUMP/ANALYZE 09508800
DISKADDR:=0&1[4:47:1]; 09509000
INTRNSC[2]:=*P(DUP) OR DISKADDR; 09509500
FOR T:=18 STEP 1 UNTIL 20 DO INTRNSC[T]:=*P(DUP) OR DISKADDR; 09510000
$ SET OMIT = NOT(AUXMEM) 09510500
INTSIZE:=(INTRNSC[0] + 3 ) DIV 4; 09534500
$ SET OMIT = NOT(PACKETS) 09534999
T:=SPACE(15); WHATINTRNSIC(T); 09535000
STREAM(S:=T,D:=3); 09535100
BEGIN 09535200
SI:=S; DI:=DI+4; % CMBIT IN M[3].[1:1] 09535300
63(IF SC="." THEN JUMP OUT; SI:=SI+1); S:=SI; 09535400
4(SI:=SI+1; IF SC="." THEN JUMP OUT); 09535500
IF TOGGLE THEN ELSE SI:=S; SI:=SI+1; 09535600
3(IF SC<"0" THEN JUMP OUT; TALLY:=TALLY+1; SI:=SI+1); 09535700
S:=TALLY; SI:=SI-S; DI:=DI-S; DS:=S CHR; 09535800
END; 09535900
FORGETSPACE(T); 09536000
$ POP OMIT 09536001
END INTRINSCI TABLE BUILDER; 09537000
PROCEDURE CHANGEINTRINSICFILE(BUFF); VALUE BUFF; REAL BUFF;% 09600000
BEGIN REAL A,B,IOD,I,J,K,L; 09601000
REAL FH,T,IT; LABEL FXIT,WITHOUT; 09602000
REAL SIZE=I,DISKADDR=T,LOC=IT,WI=J; 09602100
BOOLEAN SUBROUTINE NULLMIX;% 09603000
BEGIN POLISH(1);% 09604000
IF INTSIZE!0 THEN BEGIN INTSIZE ~ 0;% 09605000
FOR I~1 STEP 1 UNTIL MIXMAX DO% 09606000
IF JARROW[I]!0 THEN% 09607000
IF NOT (JAR[I,9].SYSJOBF) THEN % NOT "SYSTEM" JOB 09608000
BEGIN P(DEL, 0); I ~ MIXMAX; END;% 09611000
IF NOT P(DUP) THEN INTSIZE ~ (INTRNSC[0]+3) DIV 4;% 09612000
END;% 09613000
NULLMIX ~ POLISH;% 09614000
END NULLMIX;% 09615000
SUBROUTINE FORGETEM;% 09616000
BEGIN SLEEP([TOGLE],STOREMASK); LOCKTOG(STOREMASK); 09617000
WHILE (K ~ M[L]).[CF]!0 DO% 09618000
BEGIN IF K>0 THEN% 09619000
IF K.[3:12]=@700 THEN% 09620000
FORGETSPACE(L+2);% 09621000
L ~ K.[CF];% 09622000
END;% 09623000
UNLOCKTOG(STOREMASK); 09624000
$ SET OMIT = NOT(AUXMEM) 09624010
FORGETSPACE(INTRNSC INX 0); INTRNSC~0 09624100
END FORGETEM;% 09625000
DEFINE ERROR = GO TO EXIT#;% 09626000
SLEEP([TOGLE], FREEMASK); INTFREE ~ FALSE;% 09630000
T ~ BUFF;% 09631000
NAMEID(A,T); NAMEID(B,T); NAMEID(B,T);% 09632000
IF (FH:=DIRECTORYSEARCH(A,B,17))=0 THEN ERROR; 09633000
IF (J~M[FH+4].[36:6])!0 THEN 09633100
IF J!DCINTYPE AND J!TSSINTYPE THEN 09633200
BEGIN % DONT ALLOW CI ON KNOWN NON-INTRINSICS FILE 09633300
STREAM(A,B,NT1:=BUFF.[15:15]-1); 09633400
BEGIN DS:=2LIT"# "; SI:=LOC A; 09633500
SI:=SI+1; DS:=7CHR; DS:=LIT"/"; 09633600
SI:=SI+1; DS:=7 CHR; 09633700
DS:=24 LIT" NOT AN INTRINSICS FILE~"; 09633800
END; 09633900
FORGETSPACE(FH); 09634000
FORGETSPACE(DIRECTORYSEARCH(A,B,16)); 09634100
ERROR; 09634200
END; 09634300
IF NOT NULLMIX THEN COMPLEXSLEEP(NULLMIX); 09635000
IF INTRNSC!0 THEN FORGETEM; 09636000
$ SET OMIT = SHAREDISK 09636999
IF MCPFREE=0 THEN SLEEP([TOGLE],MCPMASK); 09637000
LOCKTOG(MCPMASK); 09638000
$ POP OMIT 09638001
T:=SPACE(30); 09639000
OKSEGZEROWRITE:=TRUE; %204-09639001
DISKWAIT(-T,-30,0); 09640000
I:=T+13+5|SYSNO; 09641000
IF (IT:=DIRECTORYSEARCH(M[I],M[I+1],16))!0 THEN 09642000
FORGETSPACE(T); 09643000
M[I]:=A; 09644000
M[I+1]:=B; 09645000
DISKWAIT(T,-30,0); 09646000
OKSEGZEROWRITE:=FALSE; %204-09646001
$ SET OMIT = SHAREDISK 09646999
UNLOCKTOG(MCPMASK); 09647000
$ POP OMIT 09647001
$ SET OMIT = NOT(AUXMEM) 09647999
FORGETSPACE(T); 09648000
INTRINSICTABLEBUILDER(FH.[CF]); 09657000
FORGETSPACE(FH); 09658000
WHATINTRNSIC(BUFF.[15:15]); 09659000
STREAM(B:=BUFF.[15:15]-1); DS:=8 LIT" NEW "; 09670000
EXIT: SPOUT(BUFF.[15:15]-1);% 09676000
INTFREE ~ TRUE;% 09677000
END CHANGING INTRINSIC FILES ON USER DISK WITH MANY PRECAUTIONS;% 09679000
PROCEDURE CHANGEMCP(BUFF); VALUE BUFF; REAL BUFF; 09679100
BEGIN 09679200
REAL A,B,T,Z,BASE; 09679300
LABEL EXIT; 09679400
T:=BUFF; 09679800
NAMEID(A,T); NAMEID(B,T); NAMEID(B,T); 09679900
$ SET OMIT = SHAREDISK 09679999
IF MCPFREE=0 THEN SLEEP([TOGLE],MCPMASK); 09680000
LOCKTOG(MCPMASK); 09680100
$ POP OMIT 09680101
Z:=SPACE(30); 09680200
OKSEGZEROWRITE:=TRUE; %204-09680229
DISKWAIT(-Z,-30); 09680300
BASE:=Z+10+5|SYSNO; 09680400
IF (A EQV M[BASE])!NOT 0 OR 09680500
(B EQV M[BASE+1])!NOT 0 THEN 09680600
BEGIN 09680700
IF (T:=DIRECTORYSEARCH(A,B,17))=0 THEN 09680800
BEGIN; 09680900
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09681000
BEGIN DS:=13 LIT"#NO MCP FILE ";SI:=A;SI:=SI+1; 09681100
DS:=7 CHR;DS:=LIT"/";SI:=SI+1;DS:=7 CHR; 09681200
DS~LIT"~"; 09681250
END; 09681300
GO TO EXIT; 09681400
END; 09681500
IF (NT1~M[T+4].[36:6])!0 THEN IF NT1!MCPTYPE THEN 09681505
BEGIN % DONT ALLOW CM ON KNOWN NON-MCP FILE 09681510
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09681515
BEGIN DS:=2LIT"# "; SI:=A; SI:=SI+1; 09681520
DS:=7CHR; DS:=LIT"/"; SI:=SI+1; 09681525
DS:=7CHR; DS:=12LIT" NOT AN MCP~"; 09681530
END; 09681535
FORGETSPACE(T); 09681540
FORGETSPACE(DIRECTORYSEARCH(A,B,16)); 09681545
GO TO EXIT; 09681550
END; 09681555
IF M[BASE+2]-2!MCPBASE THEN 09681600
FORGETSPACE(DIRECTORYSEARCH(M[BASE],M[BASE+1],16)); 09681650
M[BASE]:=A; 09681700
M[BASE+1]:=B; 09681800
M[BASE+2]:=M[T+10]; 09681900
$ SET OMIT = NOT(AUXMEM) 09681909
FORGETSPACE(T); 09682000
END; 09682100
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09682200
BEGIN DS:=18 LIT " NEXT MCP WILL BE ";SI:=A;SI:=SI+1; 09682300
DS:=7 CHR;DS:=LIT"/";SI:=SI+1;DS:=7 CHR; 09682400
DS~LIT"~"; 09682450
END; 09682500
M[3]~NABS(*P(DUP)); % SET FLAG FOR WM 09682550
EXIT: 09682600
DISKWAIT(Z,-30,0); 09682610
OKSEGZEROWRITE:=FALSE; %204-09682611
$ SET OMIT = NOT(NOT SHAREDISK) 09682619
UNLOCKTOG(MCPMASK); 09682620
$ POP OMIT 09682621
FORGETSPACE(Z); 09682700
SPOUT(BUFF.[15:15]-1); 09682800
END CHANGING OF THE MCP; 09683100
BOOLEAN PROCEDURE SYSTEMFILE(A,B); VALUE A,B; REAL A,B;% 09700000
BEGIN LABEL DISK,LOG,TRUTH,DIR,SYS,REM,DECK,MASK,TEST; 09701000
LABEL DMP; 09701500
LABEL MAINT; 09701550
$ SET OMIT = NOT(STATISTICS) 09701599
DEFINE T=P(TRUTH)#;% 09702000
IF (B EQV P(DISK))=T THEN% 09703000
P(((A EQV P(DIR))=T) OR 09704000
((A EQV P(LOG))=T) OR 09704100
((A EQV P(DMP))=T)) 09704500
ELSE IF (B EQV P(LOG))=T THEN% 09705000
P(((A EQV P(SYS))=T) % 09706000
$ SET OMIT = SHAREDISK 09706049
OR ((A EQV P(MAINT))=T)% 09706050
OR ((A EQV P(REM))=T)% 09706100
$ POP OMIT 09706101
)% 09706150
$ SET OMIT = NOT(SHAREDISK) 09706199
ELSE IF (A EQV P(DECK))=T THEN% 09707000
P(((B AND P(MASK)) EQV P(TEST))=T)% 09708000
$ SET OMIT = NOT(STATISTICS) 09708099
ELSE P(0);% 09709000
P(RTN);% 09710000
DISK ::: "DISK ";% 09711000
LOG ::: "LOG ";% 09712000
TRUTH::: @3777777777777777;% 09713000
DIR ::: "DIRCTRY";% 09715000
SYS ::: "SYSTEM ";% 09716000
REM ::: "REMOTE ";% 09717000
DECK ::: "DECK ";% 09718000
MASK ::: @77000000007777;% 09719000
TEST ::: @12000000003714;% 09720000
DMP ::: "DMPAREA";% 09720500
MAINT::: "MAINT ";% 09720650
$ SET OMIT = NOT(STATISTICS) 09720699
END;% 09721000
$ SET OMIT = NOT(DEBUGGING) 09999999
$ SET OMIT = NOT(WORKSET) 12200000
12200500
PROCEDURE WKSETVALUES(KTRX); VALUE KTRX; REAL KTRX; 12201000
BEGIN 12201500
12202000
% ROUTINE FOR HANDLING KEYIN WORKSET REQUESTS. 12202500
12203000
REAL 12203500
BUFF, 12204000
CYCLETOG, 12204500
ERRORTOG, 12205000
INS, 12205500
INSTRUCT, 12206000
KTR, 12206500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12207000
MONTOG, 12207500
$ POP OMIT % WORKSET MONITOR 12208000
N, 12208500
NAM, 12209000
NEXTNAME, 12209500
OLAYTOG, 12210000
STARTING, 12210500
TOLTOG, 12211000
USETOG, 12211500
VALU, 12212000
ZZSTA; 12212500
12213000
ARRAY NAMS[*]; 12213500
12214000
LABEL NU, NEW, SKAN, SKP, ERROR; 12214500
12215000
DEFINE 12215500
OLAYINDX = 1#, % CODE FOR "OLAY RATIO" 12216000
PRIORINDX = 2#, % CODE FOR "PRIORITY", 12216500
ETIMEINDX = 3#, % CODE FOR "ELAPSED TIME", 12217000
COREINDX = 4#, % CODE FOR "CORE USAGE" 12217500
SAVEINDX = 5#, % CODE FOR "SAVE CORE USAGE" 12218000
INFOSIZE = 5#, % NUMBER OF ENTRIES FOR EACH MIX 12218500
12219000
DEFINE PRINTDIGIT = % OUTPUT ROUTINE FOR STREAM STATEMENT 12219500
DV:=DI; DS:=5DEC; DI:=DV; DS:=4FILL; 12220000
DI:=DV; SI:=DV; 5(IF SC=" " THEN SI:=SI+1 ELSE DS:=CHR); 12220500
DS:=LIT","#; 12221000
12221500
BUFF := KTRX.[15:15]; % KEYIN BUFFER LOCATION 12222000
KTR := KTRX.[15:33]; % LOCATION OF REQUEST IN KEYIN BUFFER 12222500
ZZSTA := 0 & M[BUFF-2][9:9:9]; % REMOTE STATION 12223000
12223500
SKAN: % SCAN INPUT BUFFER FOR REQUEST ANALYSIS 12224000
12224500
STREAM(NAM :=0, VALU:=(-1), LOCN:=0, NEXTNAME:="~" : 12225000
TOG:=0, EQLTOG:=0, T:=0, KTR); 12225500
BEGIN 12226000
SI:=KTR; GO TO L2; 12226500
L0: 63(IF SC=ALPHA THEN SI:=SI+1 ELSE JUMP OUT TO L2); 12227000
L1: SI:=SI+1; 12227500
L2: IF SC="~" THEN GO TO L3; % END OF RECORD 12228000
IF SC=" " THEN GO TO L1; % IGNORE BLANKS 12228500
IF SC="," THEN GO TO L1; % COMMA IS OPTIONAL 12229000
IF SC="=" THEN % SET "EQUAL" TOGGLE 12229500
BEGIN 12230000
TALLY:=1; EQLTOG:=TALLY; GO TO L1; 12230500
END; 12231000
IF SC=ALPHA THEN ELSE GO TO XX0; % NO OTHER SPECIAL CHR.ALLOWED 12231500
% TREAT STRING AS NUMERIC ONLY IF PRECEEDED BY "=" 12232000
EQLTOG(IF SC GEQ "0" THEN IF SC LEQ "9" THEN JUMP OUT TO L4); 12232500
L3: TOG(DI:=LOC NEXTNAME; JUMP OUT TO LL1); % USE "NEXTNAME" 2ND.PASS 12233000
DI:=LOC NAM; % USE "NAM" ON FIRST PASS 12233500
GO TO LL1; GO TO L0; XX0: GO TO XXIT; LL1: % BRANCH POINT 12234000
DI:=DI+5; % NAME STORED IN LAST 3 CHRS. 12234500
IF SC="~" THEN % END OF RECORD,DONT MOVE SI; 12235000
BEGIN 12235500
DS:=3LIT"00~"; GO TO XXIT; 12236000
END; 12236500
T:=SI; DS:=CHR; 12237000
2(IF SC=ALPHA THEN DS:=CHR ELSE DS:=LIT" "); 12237500
TOG(SI:=T; JUMP OUT TO XXIT); % BRANCH OUT ON 2ND PASS 12238000
TALLY:=1; TOG:=TALLY; % SET SECOND PASS TOGGLE 12238500
GO TO LL0; 12239000
% NUMERICS CONVERTED AT "L4" 12239500
L4: LOCN:=SI; SI:=SI+1; TALLY:=0; EQLTOG:=TALLY; TALLY:=1; 12240000
7(IF SC GEQ "0" THEN IF SC LEQ "9" THEN; 12240500
IF TOGGLE THEN ELSE JUMP OUT; SI:=SI+1; TALLY:=TALLY+1; 12241000
SI:=LOCN; T:=TALLY; DI:=LOC VALU; DS:=T OCT; GO TO LL0; 12241500
XXIT: LOCN:=SI; 12242000
END STREAM STATEMENT; 12242500
12243000
NEXTNAME := P; % VALUE OF NEXT ITEM IN REQUEST 12243500
KTR := P; % ADDRESS OF NEXT ITEM IN KEYIN BUFFER 12244000
VALU := P; % NUMERIC VALUE OF REQUEST (-1 IF NONE GIVEN) 12244500
NAM := P; % REQUEST ITEM 12245000
12245500
IF NAM="~" THEN % NULL INPUT, TREAT AS "LIST" REQUEST 12246000
BEGIN 12246500
NU: USETOG := TOLTOG := OLAYTOG := CYCLETOG := 1; 12247000
GO TO NEW; 12247500
END 12248000
ELSE IF USETOG = 3 THEN % SETTING NEW OPTIONS 12248500
BEGIN 12249000
IF (N:=(IF (NAM="OLA" AND VALU=(-1)) THEN OLAYINDX ELSE 12249500
IF NAM="PRI" THEN PRIORINDX ELSE 12250000
IF NAM="TIM" THEN ETIMEINDX ELSE 12250500
IF NAM="COR" THEN COREINDX ELSE 12251000
IF NAM="SAV" THEN SAVEINDX ELSE 0)) NEQ 0 THEN 12251500
INSTRUCT := 0 & INSTRUCT[8:4:40] & N[4:44:4] 12252000
ELSE GO TO SKP; % MAY NOT BE PART OF "USE" COMMAND 12252500
END % IF USETOG = 3 12253000
ELSE 12253500
SKP: IF (NAM="ON " OR NAM="OFF") THEN 12254000
BEGIN 12254500
STARTING := 1 + (NAM="OFF"); 12255000
GO TO NU; 12255500
END 12256000
ELSE IF NAM="USE" THEN % SETTING NEW VALUES 12256500
BEGIN 12257000
INSTRUCT := 0; 12257500
USETOG := 3; 12258000
END 12258500
ELSE IF NAM="OPT" THEN USETOG := 1 % LISTING OPTIONS 12259000
ELSE IF NAM="TOL" THEN % TOLERANCE FOR OPTIONS 12259500
BEGIN 12260000
TOLTOG := 1; 12260500
IF VALU GEQ 0 THEN 12261000
BEGIN 12261500
IF VALU GTR 100 THEN GO TO ERROR; 12262000
WKSETTOLERANCE := VALU | 0.01; 12262500
END; 12263000
END 12263500
ELSE IF NAM = "OLA" THEN 12264000
BEGIN 12264500
OLAYTOG := 1; 12265000
IF VALU GEQ 0 THEN 12265500
BEGIN 12266000
WKSETMAXOLAY := VALU/100; 12266500
END; 12267000
END 12267500
ELSE IF NAM="CYC" THEN % CYCLE TIME 12268000
BEGIN 12268500
CYCLETOG := 1; 12269000
IF VALU GEQ 0 THEN % SETTING NEW VALUE 12269500
BEGIN 12270000
NEW: IF WKSETCYCLETIME=0 THEN % NO PREVIOUS VALUE 12270500
BEGIN 12271000
STFIRST := 0; STNEXT := 0; 12271500
IF WKSETINSTRUCT=0 THEN % SET DEFAULT OPTIONS 12272000
BEGIN 12272500
WKSETINSTRUCT := PRIORINDX & 12273000
OLAYINDX [40:44:4] & 12273500
COREINDX [36:44:4] & 12274000
ETIMEINDX[32:44:4] & 12274500
SAVEINDX [28:44:4]; 12275000
END; 12275500
IF WKSETOLERANCE=0 THEN WKSETOLERANCE := 0.10; 12276000
IF WKSETMAXOLAY=0 THEN WKSETMAXOLAY := 0.40; 12276500
END; % IF NOT PREVIOUS VALUE 12277000
IF STARTING NEQ 0 THEN % "WK ON" OR "WK OFF" 12277500
BEGIN 12278000
IF STARTING = 2 THEN % "OFF" 12278500
WKSETCYCLETIME := NABS(WKSETCYCLETIME) ELSE 12279000
BEGIN % "ON" 12279500
WKSETCYCLETIME:= 12280000
(IF WKSETCYCLETIME=0 THEN 20|64 ELSE 12280500
ABS(WKSETCYCLETIME)); 12281000
END; % IF STARTING = 1 12281500
STARTING := 0; 12282000
END; % IF STARTING GTR 0 12282500
IF VALU GEQ 0 THEN WKSETCYCLETIME := VALU|64; 12283000
IF WKSETCYCLETIME LEQ 0 THEN WKSETNOSELECT:=0; % TELL SELECTRUN12283500
END; % IF VALU GEQ 0 12284000
END % IF NAM="CYC" 12284500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12285000
ELSE IF NAM="MON" THEN 12285500
BEGIN 12286000
IF (VALU LSS 0) OR (VALU GTR 1) THEN GO TO ERROR; 12286500
WKSETMONITOR :=VALU; MONTOG:=1; 12287000
END 12287500
$ POP OMIT % WORKSETMONITOR 12288000
ELSE GO TO ERROR; 12288500
12289000
IF NAM NEQ "~" THEN 12289500
IF NEXTNAME NEQ "~" THEN 12290000
GO TO SKAN; 12290500
12291000
IF FALSE THEN 12291500
ERROR: 12292000
ERRORTOG:=1; 12292500
12293000
IF USETOG THEN 12293500
BEGIN 12294000
IF USETOG=3 THEN % NEW OPTIONS SET 12294500
IF INSTRUCT NEQ 0 THEN % NEW INSTRUCTIONS OBTAINED 12295000
BEGIN 12295500
WHILE (INSTRUCT.[44:4]=0) DO INSTRUCT:=INSTRUCT.[4:40]; 12296000
WKSETINSTRUCT := INSTRUCT; 12296500
END; 12297000
INSTRUCT := WKSETINSTRUCT; 12297500
NAMS := [M[BUFF INX 20]]&20[8:38:10]; % USE PART OF KEYIN BUFFER 12298000
NAMS[0]:=0; 12298500
N:=(-1); 12299000
WHILE (INS := INSTRUCT.[44:4]) GTR 0 DO 12299500
BEGIN 12300000
INSTRUCT := INSTRUCT.[4:40]; 12300500
NAMS[N:=N+1] := 12301000
(IF INS=1 THEN "OLAY " ELSE 12301500
IF INS=2 THEN "PRIORTY" ELSE 12302000
IF INS=3 THEN "TIME " ELSE 12302500
IF INS=4 THEN "CORE " ELSE 12303000
IF INS=5 THEN "SAVCOR " ELSE 12303500
"UNKNOWN") & 1[5:47:1]; 12304000
NAMS[N+1]:=0; 12304500
END; 12305000
END; % IF USETOG 12305500
STREAM(CYCLETOG, NEG:=(WKSETCYCLETIME.[1:1]), 12306000
CYC:=(ABS[WKSETCYCLETIME)/64+0.5) DIV 1, 12306500
ERRORTOG, VALUTOG:=(VALU GEQ 0), NAM, VALU, 12307000
OLAYTOG, OLA:=(WKSETMAXOLAY|100+0.5) DIV 1, 12307500
TOLTOG, TOL:=(WKSETOLERANCE|100+0.5) DIV 1, 12308000
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12308500
MONTOG, MON:=WKSETMONITOR, 12309000
$ POP OMIT % WORKSETMONITOR 12309500
USETOG, NM:=NAMS INX 0, DV:=0, BUFF:=BUFF-1); 12310000
BEGIN 12310500
DS:=4LIT"WK:"; 12311000
ERRORTOG(DS:=7LIT" ERROR:"; SI:=LOC NAM; SI:=SI+5; DS:=3CHR; 12311500
VALUTOG(DS:=LIT"="; SI:=LOC VALU; DS:=8DEC; 12312000
DV:=DI; DI:=DI-8; DS:=7FILL; DI:=DV); DS:=LIT" "); 12312500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12313000
MONTOG(DS:=4LIT"MON="; SI:=LOC MON; PRINTDIGIT); 12313500
$ POP OMIT % WORKSETMONITOR 12314000
CYCLETOG(DS:=6LIT"CYCLE="; NEG(DS:=LIT"-"); 12314500
SI:=LOC CYC; PRINTDIGIT); 12315000
OLAYTOG(DS:=5LIT"OLAY="; 12315500
SI:=LOC OLA; PRINTDIGIT); 12316000
TOLTOG(DS:=4LIT"TOL="; 12316500
SI:=LOC TOL; PRINTDIGIT); 12317000
USETOG(SI:=NM; DS:=9LIT"OPTIONS: "; 12317500
L1: IF SC="0" THEN JUMP OUT; 12318000
SI:=SI+1; 7(IF SC=" " THEN SI:=SI+1 ELSE DS:=CHR); 12318500
DS:=LIT","; GO TO L1); 12319000
DI:=DI-1; DS:=LIT"~"; 12319500
END STREAM STATEMENT; 12320000
12320500
SPOUT((BUFF-1) INX (0&ZZSTA[9:9:9])); 12321000
NAMS:=[M[NAM:=SPACE(30)]] & 30[8:38:10]; %143-12321100
DISKWAIT(-NAM,30,DIRECTORYTOP+1); %143-12321110
NAMS[N:=4|SYSNO+4]:=WKSETCYCLETIME; %143-12321120
NAMS[N+1 ]:=WKSETINSTRUCT; %143-12321130
NAMS[N+2 ]:=WKSETOLERANCE; %143-12321140
NAMS[N+3 ]:=WKSETMAXOLAY; %143-12321150
DISKWAIT( NAM,30,DIRECTORYTOP+1); %143-12321160
FORGETSPACE(NAM); %143-12321170
END PROCEDURE WKSETREQUESTS; 12321500
12350000
PROCEDURE WORKSET(N); VALUE N; REAL N; 12350500
BEGIN 12351000
REAL MSCW = -2; 12351500
REAL 12352000
DEVIATION, 12352500
INS, 12353000
INSTRUCT, 12353500
LINK, 12354000
LOC, 12354500
MAXMIX, 12355000
MAXOLAY, 12355500
MAXVALUE, 12356000
MIX, 12356500
NJOBS, 12357000
PTIME, 12357500
TOTALPTIME, 12358000
OLAY, 12358500
TOTALOLAY, 12359000
STARTING, 12359500
STOPMIX, 12360000
SIZE, 12360500
T1, 12361000
T2, 12361500
TOTALOLAYCORE, 12362000
TOTALSAVECORE, 12362500
TOTALSYSTEMCORE, 12363000
VALU; 12363500
12364000
ARRAY JOBINFO[*]; 12364500
ARRAY RUNNING[*]; 12365000
12365500
DEFINE 12366000
OLAYINDX = 1#, % CODE FOR "OLAY RATIO" 12366500
PRIORINDX = 2#, % CODE FOR "PRIORITY", 12367000
ETIMEINDX = 3#, % CODE FOR "ELAPSED TIME", 12367500
COREINDX = 4#, % CODE FOR "CORE USAGE" 12368000
SAVEINDX = 5#, % CODE FOR "SAVE CORE USAGE" 12368500
INFOSIZE = 5#; % NUMBER OF ENTRIES FOR EACH MIX 12369000
12369500
DEFINE INFO[INFO1,INFO2] = JOBINFO[INFO1|INFOSIZE+INFO2-1]#; 12370000
12370500
LABEL START, LOOP, FINISHED; 12371000
12371500
COMMENT 12372000
THE "INSTRUCTIONS" ARE STORED IN THE GLOBAL VARIABLE 12372500
"WKSETINSTRUCT", USING FIELDS FOUR BITS IN LENGTH. 12373000
THE FIRST "INSTRUCTION" WILL BE IN THE [44:4] FIELD, THE 12373500
SECOND "INSTRUCTION" WILL BE IN THE [40:4] FIELD, AN SO FORTH. 12374000
THESE "INSTRUCTIONS" ARE THE NUMERICAL VALUES CORRESPONDING TO 12374500
CODES DEFINED ABOVE. 12375000
12375500
AS AN EXAMPLE OF HOW THESE "INSTRUCTIONS" ARE USED, SUPPOSE THAT 12376000
WKSETINSTRUCT.[44:4] CONTAINED A VALUE OF 3, 12376500
WKSETINSTRUCT.[40:4] CONTAINED A VALUE OF 2, AND THE 12377000
REMAINDER OF THE WKSETINSTRUCT WORD WERE ZERO. IN THIS 12377500
INSTANCE, THIS ROUTINE WOULD FIRST EXAMINE ALL JOBS IN THE 12378000
MIX, FINDING THE JOB WHICH HAD BEEN RUNNING FOR THE LONGEST 12378500
PERIOD OF TIME. NEXT, ALL JOBS WHICH HAVE BEEN RUNNING FOR A 12379000
PERIOD OF TIME WHICH IS WITHIN THE "WKSETOLERANCE" (NORMALLY 12379500
WITHIN ABOUT 10% OF THE MAXIMUM VALUE FOUND ABOVE) ARE EXAMINED 12380000
FOR THE NEXT "INSTRUCTION", THAT IS, THE PRIORITY. 12380500
IN THIS MANNER, THE JOB WHICH HAS BEEN RUNNING FOR THE LONGEST 12381000
PERIOD OF TIME, AND WHICH HAS THE HIGHEST PRIORITY WILL BE 12381500
SELECTED FOR "STOPPING". 12382000
END OF COMMENT; 12382500
12383000
12383500
SUBROUTINE CORESEARCH; 12384000
BEGIN 12384500
MAXMIN := 0; 12385000
% SEARCH THE LINKS TO DETERMINE CORE USAGE 12385500
IF NOT STOREDY THEN SLEEP([TOGLE],STOREMASK); 12386000
LOC := 0; % START AT LOW WND OF MEMORY 12386500
TOTALSYSTEMCORE := TOTALOLAYCORE := TOTALSAVECORE := 0; 12387000
WHILE (SIZE:=(LINK:=M[LOC]).[CF] -LOC) GEQ 0 DO 12387500
BEGIN 12388000
TOTALSYSTEMCORE := TOTALSYSTEMCORE + SIZE; 12388500
IF NOT LINK.[1:1] THEN % IN-USE AREA 12389000
BEGIN 12389500
IF (MIX:=LINK.[9:6]) GTR MAXMIX THEN MAXMIX := MIX; 12390000
IF LINK.[2:1] THEN % SAVE AREA 12390500
BEGIN 12391000
TOTALSAVECORE := TOTALSAVECORE + SIZE; 12391500
INFO[MIX,SAVEINDX] := INFO[MIX,SAVEINDX] - SIZE; 12392000
% NOTE: JOBS SHOULD BE STOPPED IN INVERSE RELATION TO 12392500
% AMOUNT OF SAVE CORE USED 12393000
END 12393500
ELSE 12394000
BEGIN 12394500
TOTALOLAYCORE := TOTALOLAYCORE + SIZE; 12395000
INFO[MIX,COREINDX] := INFO[MIX,COREINDX] + SIZE; 12395500
END; 12396000
END; % IF IN-USE AREA 12396500
LOC := LINK.[CF]; % NEXT LINK 12397000
END; % WHILE STATEMENT 12397500
FOR MIX := 1 STEP 1 UNTIL MAXMIX DO 12398000
IF RUNNING[MIX] THEN 12398500
IF PRYOR[MIX] LSS 0 THEN % CHECK AGAIN (LOSS OF CNTRL,ABOVE)12399000
BEGIN 12399500
RUNNING[MIX] := 0; 12400000
NJOBS := NJOBS - 1; 12400500
END; 12401000
% DONT USE JOBS WHICH ARE TERMINATING OR JUST STARTING 12401500
IF NJOBS LSS 2 THEN GO TO FINISHED; 12402000
END SUBROUTINE CORESEARCH; 12402500
12403000
IF (CLOCK+P(RTR)-WKSETSWITCHTIME) LSS 960 THEN 12403500
BEGIN 12404000
% ALLOW 15 SECONDS AFTER THE LAST "BOJ" OR "EOJ" 12404500
% BEFORE TESTING THE OVERLAY RATE 12405000
WKSETCLOCK:=(P(DUP)) + 960; 12405500
GO TO FINISHED; 12406000
END; 12406500
RUNNING := [M[T1:=SPACE(MIXMAX+1)]] & 12407000
(MIXMAX+1)[8:38:10]; 12407500
JOBINFO := [M[T2:=SPACE((MIXMAX+1)|INFOSIZE)]] & 12408000
((MIXMAX+1)|INFOSIZE)[8:38:10]; 12408500
12409000
START: 12409500
12410000
STREAM(F1:=T1-1,SZ1:=MIXMAX+1,F1:=T2-1, 12410500
SZ2 := (MIXMAX+1)|INFOSIZE, T1,T2); 12411000
BEGIN % ZERO OUT THE ARRAYS 12411500
SI:=F2; DS:=SZ2 WDS; SI:=F1; DI:=T1, DS:=SZ1 WDS; 12412000
END; 12412500
NJOBS := TOTALPTIME := TOTALOLAY := MAXOLAY := 0; 12413000
FOR MIX:=1 STEP 1 UNTIL MIXMAX DO 12413500
IF JARROW[MIX] NEQ 0 THEN % RUNNING JOB 12414000
IF NOT(JAR[MIX,9].[3:1]) THEN % NOT ALREADY STOPPED 12414500
IF (PRYOR[MIX] GEQ 0) AND (REPLY[MIX]=0) THEN 12415000
BEGIN 12415500
IF NOT(JAR[MIX,9].SYSJOBF) THEN %NOT "SYSTEM JOB 12416000
BEGIN 12416500
RUNNING[MIX] := 1; 12417000
NJOBS := NJOBS + 1; % COUNT THE NUMBER OF JOBS 12417500
END; 12418000
INFO[MIX,ETIMEINDX]:= 12418500
NABS(CLOCK+P(RTR)-NFO[MIX-1)|NXD+2].[1:17]|60); 12419000
PTIME := JAR[MIX,3] + PROCTIME[MIX]; 12419500
$ SET OMIT = NEWLOGGING OR OMIT 12419599
IF (P1MIX=MIX OR P2MIX=MIX) THEN 12419600
$ POP OMIT 12419601
$ SET OMIT = NOT(NEWLOGGING) OR OMIT 12419699
PTIME := PTIME+CLOCK+P(RTR); 12420000
IF (INFO[MIX,OLAYINDX]:= 12420500
OLAYTIME[MIX]/PTIME) GTR MAXOLAY THEN 12421000
IF RUNNING[MIX] THEN 12421500
MAXOLAY:=INFO[MIX,OLAYINDX]; % FIND MAX.VALUE 12422000
INFO[MIX,PRIORINDX] := PRYOR[MIX].[CF]; 12422500
TOTALOLAY := TOTALOLAY + OLAYTIME[MIX]; 12423000
TOTALPTIME:= TOTALPTIME + PTIME; 12423500
END; % MIX LOOP; 12424000
12424500
MIX~WKSETNOSELECT; %525-12424700
WKSETNOSELECT:=((OLAY:=TOTALOLAY/TOTALPTIME) GEQ (WKSETMAXOLAY|.85));12425000
IF MIX AND NOT WKSETNOSELECT THEN SELECTION; % SEE IF ANYTHING CAN GO 12425200
% NOTE: WKSETNOSELECT IS A FLAG TO PROCEDURE SELECTRUN TO 12425500
% PREVENT ENTERING ADDITIONAL JOBS INTO THE MIX 12426000
IF (OLAY GTR WKSETMAXOLAY) OR (MAXOLAY GTR (WKSETMAXOLAY|4)) THEN 12426500
% SUSPEND SOMETHING IF THE TOTAL OLAY RATE EXCEEDS MAX. VALUE 12427000
% SPECIFIED, OR ANY INDIVIDUAL RATE EXCEEDS 4 TIMES THE MAX. 12427500
% RATE SPECIFIED. 12428000
IF NJOBS GTR1 THEN % MORE THAN ONE JOB IS RUNNING 12428500
BEGIN 12429000
CORESEARCH; % SEARCH MEMORY TO DETERMINE CORE USAGE 12429500
% NOW DETERMINE WHICH JOB TO STOP BASED ON THE PRIORITY OF 12430000
% THE INSTRUCTIONS IN "WKSETINSTRUCT" 12430500
STOPMIX := -1; 12431000
INSTRUCT := WKSETINSTRUCT; 12431500
STARTING := TRUE; 12432000
12432500
LOOP: 12433000
12433500
IF (INS:=INSTRUCT.[44:4]) NEQ 0 THEN % MORE INSTRUCTIONS 12434000
BEGIN 12434500
INSTRUCT := 0 & INSTRUCT[8:4:40]; % SHIFT RIGHT FOR NXT.INSTR. 12435000
MAXVALUE := (IF STARTING THEN (-33000) ELSE INFO[STOPMIX,INS]);12435500
STARTING := FALSE; 12436000
% FIRST, FIND THEMAXIMUM VALUE 12436500
FOR MIX:=1 STEP 1 UNTIL MAXMIX DO 12437000
IF RUNNING[MIX] THEN 12437500
IF (VALU := INFO[MIX,INS]) GTR MAXVALUE THEN 12438000
BEGIN 12438500
MAXVALUE := VALU; 12439000
STOPMIX := MIX; 12439500
END; 12440000
12440500
% NEXT, FIND THE VALUES WITHIN THE WORK SET TOLERANCE 12441000
12441500
FOR MIX:=1 STEP 1 UNTIL MAXMIX DO 12442000
IF MIX NEQ STOPMIX THEN 12442500
IF RUNNING[MIX] THEN 12443000
BEGIN 12443500
DEVIATION := (MAXVALUE-INFO[MIX,INS])/MAXVALUE; 12444000
IF ABS(DEVIATION) GTR WKSETOLERANCE THEN 12444500
BEGIN 12445000
RUNNING[MIX]:=0; 12445500
NJOBS := NJOBS -1; 12446000
END; 12446500
END; 12447000
IF NJOBS GTR 1 THEN GO TO LOOP; 12447500
END; % IF THERE WERE MORE INSTRUCTIONS 12448000
12448500
IF STOPMIX GTR 0 THEN % SOMETHING SHOULD BE STOPPED 12449000
BEGIN 12449500
IF NOTERMSET(STOPMIX) THEN % JOB IS NOT TERMINATING 12451000
BEGIN 12451500
PRTROW[STOPMIX].[PSF]:=2; % MARK IT STOPPED 12452000
WKSETSWITCHTIME:=CLOCK+P(RTR); 12452500
WKSETSTOPJOBS:=WKSETSTOPJOBS OR TWO(STOPMIX); % MARK AUTO-ST12453000
WKSETNOSELECT:=TRUE; %138-12453100
JAR[STOPMIX,9].[3:1]:=1; % MARK IT STOPPED 12453500
STQUE[STNEXT]:=STOPMIX; % PUT IT IN THE STQUE 12454000
STNEXT := (STNEXT+1).[44:4]; % CIRCULAR QUEUE, 16 ENTRIES 12454500
END; % IF WE ARE STOPPING THE JOB 12455000
END; % IF SOMETHING SHOULD BE STOPPED 12455500
$ SET OMIT = NOT(WORKSETMONITOR) OR OMIT 12456000
IF WKSETMONITOR THEN 12456500
IF STOPMIX GTR 0 THEN 12457000
FOR STOPMIX:=1 STEP 1 UNTIL MIXMAX DO 12457500
IF JARROW[STOPMIX] NEQ 0 THEN 12458000
IF PRTROW[STOPMIX] NEQ 0 THEN 12458500
IF INFO[STOPMIX,OLAYINDX] GTR 0 THEN 12459000
BEGIN 12459500
STREAM( 12460000
V1:="MIX=", 12460500
V2:=STOPMIX, 12461000
V3:="RAT=", 12461500
V4:=(INFO[STOPMIX,OLAYINDX]|100+0.5) DIV 1, 12462000
V5:="PRI=", 12462500
V6:=INFO[STOPMIX,PRIORINDX], 12463000
V7:="TIM=", 12463500
V8:=(ABS(INFO[STOPMIX,ETIMEINDX])/64+ 0.5) DIV 1, 12464000
V9:="COR=", 12464500
V10:=INFO[STOPMIX,COREINDX], 12465000
V11:="SAV=", 12465500
V12:=ABS(INFO[STOPMIX,SVEINDX]), 12466000
V13 := "TOT=", 12466500
V14 := (TOTALOLAY/TOTALPTIME|100+0.5) DIV 1, 12467000
DV:=0, 12467500
D:=T1:=SPACE(15)); 12468000
BEGIN 12468500
SI:=LOC V1; DS:=LIT" "; 12469000
7(SI:=SI+4; DS:=4CHR; DS:=5DEC; 12469500
DV:=DI; DI:=DI-5; DS:=4FILL; DS:=DV; DS:=LIT" "); 12470000
DS:=LIT"~"; 12470500
END STREAM; 12471000
SPOUT(T1); 12471500
END; 12472000
$ POP OMIT % WORKSETMONITOR 12472500
END %142-12473000
ELSE %142-12473010
ELSE %142-12473020
IF WKSETSTOPJOBS GTR 0 THEN %142-12473030
IF (OLAY LSS (WKSETMAXOLAY/2)) THEN % START SOMETHING %142-12473040
BEGIN %142-12473050
STNEXT:=IF STNEXT=0 THEN STQUEMAX ELSE STNEXT-1; %142-12473060
STOPMIX:=STQUE[STNEXT]; %142-12473070
STQUE[STNEXT]:=0; %142-12473080
IF (STOPMIX GTR 0) AND (STOPMIX LEQ MIXMAX) THEN %142-12473090
IF JARROW[STOPMIX] NEQ 0 THEN %142-12473100
BEGIN %142-12473110
IF STOPSET(STOPMIX) THEN % NOT YET STOPPED %142-12473120
BEGIN %142-12473130
PRTROW[STOPMIX].[PSF]:=0; %142-12473140
WKSETSTOPJOBS:=WKSETSTOPJOBS AND NOT(TWO(STOPMIX)); %142-12473150
JAR[STOPMIX,9].[3:1]:=0; %142-12473160
END ELSE %142-12473170
BEGIN %142-12473180
REPLY[STOPMIX]:=VOK; % WAKE IT UP %142-12473190
STREAM(J:=JARROW[STOPMIX], STOPMIX, %142-12473200
D:=T1:=SPACE(10)); %142-12473210
BEGIN %142-12473220
SI:=J; DS:=9 LIT" AUTO-OK "; %142-12473230
2(SI:=SI+1; DS:=7 CHR; DS:=LIT "/"); %142-12473240
DI:=DI-1; DS:=LIT"="; SI:=LOC STOPMIX; %142-12473250
DS:=2 DEC; DS:=LIT"~"; DI:=DI-3; DS:=FILL; %142-12473260
END STREAM STATEMENT; %142-12473270
SPOUTER(T1,PSEUDOMIX[STOPMIX],1); %525-12473280
END; %142-12473290
END; %142-12473300
END; %142-12473310
FINISHED: 12473500
IF JOBINFO NEQ 0 THEN FORGETSPACE(JOBINFO INX 0); 12474000
IF RUNNING NEQ 0 THEN FORGETSPACE(RUNNING INX 0); 12474500
WKSETRUNNING := 0; % READY FOR NEXT CYCLE 12475000
KILL([MSCW]); 12475500
END; 12476000
$ POP OMIT % WORKSET 12477000
REAL PROCEDURE PRNPBTSPECASE1(Z); 12500000
% 12500100
% THIS PROCEDURE HANDLES THE FOLLOWING FUNCTIONS FOR COM19, DEPENDING 12500110
% ON THE VALUE OF Z: 12500120
% 0 FINDS THE NEXT REEL OF TAPE. 12500130
% 1 FINDS THE NEXT REEL OF A BACK-UP DISK FILE. 12500140
% 2 HANDLES THE QT + OR - MESSAGE. 12500150
% 3 INITAILIZES A NEW FILE (OR PACKET). 12500160
% 4 HANDLES TERMINATION OF A FILE. 12500170
% 12500180
VALUE Z; REAL Z; 12500500
BEGIN 12501000
REAL RCW=+0, MSCW=-2, COMMON=-4; 12501500
ARRAY INREC=+1[*]; 12502000
ARRAY FPB=INREC+1[*], LOGINFO=FPB+1[*], HEADER=LOGINFO+1[*]; 12502500
REAL UNIT=HEADER+1, V=UNIT+1, COPY=V+1, MFID=COPY+1, FID=MFID+1, 12503000
IOD=FID+1, T=IOD+1, B=T+1; 12503500
REAL SEARCHVAL=B+1, CURROW=SEARCHVAL+1, FIRSTFID=CURROW+1, 12504000
SEGNR=FIRSTFID+1; 12504500
REAL X=SEARCHVAL, NUM=CURROW, RECOUNT=SEGNR; 12505000
BOOLEAN SIGNEDON=SEGNR+1, FORMTOG=SIGNEDON+1, ABORTED=FORMTOG+1; 12505500
BOOLEAN TERMFLAG=LOGINFO, NOCONT=FIRSTFID; 12506000
$ SET OMIT = NOT PACKETS 12506500
BOOLEAN STOG=ABORTED+1; 12507000
REAL PCOPY=STOG+1, PFIRSTFID=PCOPY+1; 12507500
$SET OMIT = NOT (RJE AND PACKETS) 12508000
$ SET OMIT = PACKETS 12509500
12512000
LABEL RD, RED, SPACEND, NOMORE, NOFILE, AUT, BOMBER, NEXTFILE, 12512500
PNCHLK, PRINTITAGAIN, EOF, PRNTDS, PNCHDS, TAPEND, CONTINUE,12513000
RETURNFALSE, REMOVEM, TEST, TAPECL, STOPTIME, RETURNTRUE, 12513500
RETURNTOCOM19; 12513750
LABEL LOOK4TAPE, NOMOREELS, QTSPEC, INITIALIZE, STARTANEWFILE; 12514000
SWITCH SW := 12514500
LOOK4TAPE, NOMOREELS, QTSPEC, INITIALIZE, STARTANEWFILE; 12515000
DEFINE DSED = TERMSET(P1MIX)#, 12515500
QTED = (PRT[P1MIX,@25]!0)#, 12516000
VF = 43:5#, 12516100
UNITE = 38:5#, 12516150
COPYF = 30:8#, 12516200
NUMF = 22:8#, 12516250
NOTP = 29:1#, 12516300
COPY0 = 21:1#, 12516350
$ SET OMIT = PACKETS 12516500
REELNO = 42:6#, 12518000
$ POP OMIT OMIT 12518500
$ SET OMIT = RJE 12518600
STA = 0#, 12518700
$ POP OMIT 12518800
SEPARATION = 46#; % FOR 6 LPI. SET IT TO 70 FOR 8 LPI. 12519000
%***********************************************************************12519500
12520000
SUBROUTINE RDYTAPE; 12520500
BEGIN 12521000
B.[18:9]:=@54; 12521500
P(WAITIO(@4200000000,0,UNIT),DEL); 12522000
P(WAITIO(B,0,UNIT),WAITIO(B,@40,UNIT),DEL,DEL); 12522500
RECOUNT:=@77777; 12523000
END; 12523500
12524000
%***********************************************************************12524500
12525000
SUBROUTINE REWIND; 12525500
BEGIN 12526000
STOPIMING(1,1023); 12526500
P(WAITIO(@4200000000,0,UNIT),DEL); 12527000
IF (SAVEWORD AND TWO(UNIT))=0 AND PRNTABLE[UNIT].[1:1] 12527500
AND NOT (SVPBT OR QTED OR NOCONT) THEN 12528000
BEGIN RDCTABLE[UNIT].[8:6]~0; %539-12528400
INDEPENDENTRUNNER(P(.PURGEIT),UNIT,64) 12528500
END %539-12528600
ELSE 12529000
BEGIN LABELTABLE[UNIT]~@114; 12529500
MULTITABLE[UNIT]~RDCTABLE[UNIT]~0; 12530000
SLEEP([TOGLE],STATUSMASK); 12530500
READY~READY AND NOT NT1~TWO(UNIT); 12531000
RRRMECH~NOT NT1 AND RRRMECH OR NT1 AND SAVEWORD; 12531500
END; 12532000
END; 12532500
12533000
%***********************************************************************12533500
12534000
BOOLEAN PROCEDURE LOOKFORTAPE; 12534500
BEGIN 12535000
T:=RDCTABLE[UNIT]; 12535500
REWIND; 12536000
IF SIGNEDON THEN FPB[4]:=FPB[4]-LOGINFO[24]-CLOCK-P(RTR); 12536500
IF P((T:=FINDINPUT(MFID,@122212342546447,T.[14:10]+1,T.[24:17],12537000
-0,0,T:=0,0,0,0)) GEQ 0, DUP) THEN 12537500
BEGIN 12538000
RDCTABLE[UNIT:=T].[8:6]:=P1MIX; 12538500
LABELTABLE[UNIT]:=FID; 12539000
FPB:=PRT[P1MIX,3]; % FINDINPUT CALLS STARTIMING 12539500
IF SIGNEDON THEN FPB[4]:=FPB[4]+LOGINFO[24]+CLOCK+P(RTR); 12540000
RDYTAPE; 12540500
END; 12541000
LOOKFORTAPE:=P; 12541500
END; 12542000
12542500
%***********************************************************************12543000
12543500
REAL SUBROUTINE READTAPE; 12544000
BEGIN 12544500
RD: IF DSED OR PRT[P1MIX,@25]=5 THEN BEGIN P(5); GO TO RED END; 12545000
IF WAITIO(B,@2000040,UNIT).[42:1] THEN 12545500
BEGIN 12546000
P(WIATIO(B,@3000040,UNIT),DEL); 12546500
IF M[B INX 3] THEN 12547000
IF LOOKFORTAPE THEN GO TO RD; 12547500
P(3); 12548000
GO TO RED; 12548500
END; 12549000
FOR T:=17 STEP 18 UNTIL 89 DO 12549500
IF M[B INX T].[20:1] THEN T:=256; 12550000
P(T>200); 12550500
RED: READTAPE:=P; 12551000
END; 12551500
12552000
%***********************************************************************12552500
12553000
BOOLEAN SUBROUTINE SPACETOFILE; 12553500
BEGIN 12554000
X:=NUM; 12554500
WHILE (X:=X-1) GEQ 0 DO 12555000
BEGIN 12555500
DO UNTIL (T:=READTAPE); 12556000
IF T GEQ 3 THEN BEGIN P(1) GO TO SPACEND END; 12556500
END; 12557000
P(0); 12557500
SPACEND: 12558000
SPACETOFILE:=P; 12558500
END; 12559000
12559500
%***********************************************************************12560000
12560500
BOOLEAN SUBROUTINE FINDFILE; 12561000
BEGIN 12561500
IF HEADER.[CF] GEQ 64 THEN FORGETSPACE(HEADER); %159-12561600
IF (HEADER:=DIRECTORYSEARCH(MFID,-FID,SEARCHVAL)) LSS 64 THEN 12562000
GO TO NOMORE; 12562500
HEADER:=[M[HEADER]]&30[8:38:10]; 12563000
SEGNR:=0; 12563500
CURROW:=10; 12564000
IF ABORTED:=HEADER[5].[2:1] THEN 12564500
IF HEADER[7]=0 THEN 12565000
BEGIN 12565500
NOMORE: P(1); 12566000
GO TO NOFILE; 12566500
END; 12567000
LABELTABLE[V]:=NABS(FID); 12567500
P(0); 12568000
NOFILE: FINDFILE:=P; 12568500
END; 12569000
12569500
%***********************************************************************12570000
12570500
BOOLEAN SUBROUTINE NOMOREREELS; 12571000
BEGIN 12571500
IF FID.[REELNO]=0 THEN 12572500
P(1) %159-12573500
ELSE %159-12574000
BEGIN 12574500
STREAM[ONE:=1, F:=[FID]); 12575000
BEGIN SI:=LOC ONE; DS:=8 ADD END; 12575500
P(FINDFILE); 12576000
END; 12576500
NOMOREREELS:=P; 12577000
END; 12577500
$ SET OMIT = NOT PACKETS 12578000
12578500
%***********************************************************************12579000
12579500
BOOLEAN SUBROUTINE NOMOREFILES; 12580000
BEGIN 12580500
IF NOT P(FID.[30:12]="99" OR COMMON.[NOTP],DUP) THEN 12581000
BEGIN 12581500
P(DEL); 12582000
STREAM(ONE:=1, F:=[FID]); 12582500
BEGIN SI:=LOC ONE; SI:=SI+6; SI:=SI+5; 12583000
DS:=2 ADD; DS:=LIT"1"; 12583500
END; 12584000
FIRSTFID:=FID; 12584500
P(FINDFILE); 12585000
END; 12585500
NOMOREFILES:=P; 12586000
END; 12586500
$ POP OMIT 12587000
12587500
%***********************************************************************12588000
12588500
SUBROUTINE REMOVEIT; 12589000
BEGIN 12589500
T:=DIRECTORYSEARCH(-MFID,-(FID:=PFIRSTFID),SEARCHVAL); 12590000
IF T GEQ 64 THEN 12590500
$ SET OMIT = NOT PACKETS 12591000
DO BEGIN 12591500
$ POP OMIT 12592000
DO IF FID=IOD THEN GO AUT UNTIL NOMOREREELS; 12592500
$ SET OMIT = NOT PACKETS 12593000
END UNTIL NOMOREFILES; 12593500
$ POP OMIT 12594000
AUT: 12594500
END; 12595000
12595500
%***********************************************************************12596000
12596500
SUBROUTINE PAGEJECT; 12597000
BEGIN 12597500
$ SET OMIT = NOT RJE 12598000
P(WAITIO(@4000100000,0,V), DEL); 12600500
END; 12601000
12601500
%***********************************************************************12602000
12602500
SUBROUTINE WRITER; 12603000
BEGIN 12603500
$ SET OMIT = NOT RJE 12604000
P(WIATIO(B INX @210104000000,0,V), DEL); 12607000
END; 12607500
12608000
%***********************************************************************12608500
12609000
SUBROUTINE IDLETIMER; 12609500
BEGIN 12610000
STOPLOG(P1MIX,1); 12610100
P(P1MIX); P1MIX:=0; 12610500
IDLETIME; 12611000
P1MIX:=P; 12611500
$ SET OMIT = NOT(NEWLOGGING) 12611899
STARTLOG(P1MIX); 12612000
END IDLETIMER; 12612500
12613000
%***********************************************************************12613500
12614000
SUBROUTINE SETUPINREC; 12614500
BEGIN 12615000
INREC:=[M[B INX (UNIT=18)]]&18[8:38:10]; 12615500
INREC[17]:=0; 12616000
END; 12616500
12617000
%***********************************************************************12617500
12618000
SUBROUTINE INVALIDNUM; 12618500
BEGIN 12618750
FILEMESS("INVALID","FILE ",0,"NUMB #",NUM+1,0,0); 12619000
END; 12619250
12619500
%***********************************************************************12620000
12620500
P(DEL,Z,MSCW,STF); 12621000
GO TO SW[P]; % LOOK4TAPE,NOMOREELS,QTSPEC,INITIALIZE,STARTANEWFILE12621500
% 12621900
% LOOKFORTAPE FINDS THE NEXT REEL. THE FIRST RECORD IS A LABEL SO 12621910
% INREC IS MOVED DOWN TO SKIP IT. 12621920
12621930
LOOK4TAPE: 12622000
12622100
P(LOOKFORTAPE); 12622500
IF M[B+89].[1:11]=0 THEN % LABEL RECORD 12623000
BEGIN 12623100
INREC~(NOT 17) INX INREC; 12623200
RECOUNT~0; 12623300
END; 12623400
GO RETURNTOCOM19; 12624000
12624400
NOMOREELS: 12624500
12624600
P(NOMOREREELS); 12625000
GO RETURNTOCOM19; 12625500
12625900
QTSPEC: 12626000
12626100
PRT[P1MIX,@25]:=0; 12626250
P(T); % BE CAREFUL OF THIS. 12626500
IF UNIT=18 THEN % DISK PORTION 12626750
BEGIN NT2:=(T.[9:24] DIV 5)&T[1:2:1]; 12627000
IOD:=(HEADER[8] DIV 3)|3; % CALCULATE TRUE ROW SIZE 12627500
IF (T:=3|NT2+SEGNR) LSS 0 THEN % SPACE BACKWARD 12628000
DO IF (CURROW:=CURROW-1) LSS 10 THEN 12628500
BEGIN 12629000
IF FID=FIRSTFID THEN GO TO BOMBER; 12629500
IF SEARCHVAL=3 THEN P(DIRECTORYSEARCH(-MFID,FID,13),DEL); 12630000
FORGETSPACE(HEADER); 12630500
STREAM(ONE:=1, F:=[FID]); 12631000
BEGIN SI:=LOC ONE; DS:=8 SUB END; 12631500
IF (HEADER:=DIRECTORYSEARCH(MFID,FID,5)) LSS 64 12632000
THEN GO BOMBER; 12632002
HEADER:=[M[HEADER]]&30[8:38:10]; 12632500
CURROW:=HEADER[9].[43:5]+9; 12633000
WHILE HEADER[CURROW]=0 DO CURROW:=CURROW-1; 12633500
IF CURROW<10 THEN 12634000
BEGIN 12634500
BOMBER: NT1:="RANGE +"; 12635000
IF (NT2:=P).[2:1] THEN % LEFT AT 12626500%168-12635500
NT1:=NT1&"-"[42:42:6]; 12636000
FILEMESS("INVALID","QT ",0, 12636500
NT1,NT2.[9:24],0,0); 12637000
PRT[P1MIX,@25]:=5; % FORCE A QT 12637500
GO RETURNFALSE; 12638500
END; 12639000
END UNTIL (T:=IOD+T) GEQ 0 12639500
ELSE % SPACE DISK FORWARD 12640000
BEGIN 12640500
IF T GEQ IOD THEN % TO ANOTHER ROW, 12641000
DO % CHECKING FOR NEW FILE12641500
IF (CURROW:=CURROW+1) GEQ (HEADER[9].[43:5]+10) THEN 12642000
NEXTFILE: IF NOMOREREELS THEN GO TO BOMBER 12642500
UNTIL (T:=T-IOD) LSS 100; 12643000
IF (CURROW-10)|IOD+T GTR HEADER[7]|3 THEN 12643500
GO TO NEXTFILE; 12644000
END; 12644500
SEGNR:=T; 12645000
P(19); 12645500
END ELSE % TAPE PORTION 12646000
BEGIN 12646500
IF T.[2:1] THEN % SPACE BACKWARD 12647000
IF (T:=T.[9:24]) LSS INREC[17].[CF] THEN 12647500
BEGIN IOD:=(I+4) DIV 5; 12648000
DO P(WAITIO((89 INX B)&7[22:45:3],0,UNIT),DEL) 12648500
UNTIL (IOD:=IOD-1) LEQ 0 OR DSED OR QTED; 12649000
RECOUNT:=5; 12649500
END ELSE GO TO BOMBER % REEL SWITCH NOT ALLOWED 12650000
ELSE 12650250
BEGIN IF (IOD:=T.[9:24] DIV 5) ! 0 THEN % SPACE FORWARD %168-12650500
DO UNTIL (X:=READTAPE) OR (IOD:=IOD-1)=0; 12651000
IF IOD!0 THEN 12651500
IF X!5 THEN GO TO BOMBER; % 5=DS-ED, LET IT FALL THRU.12652000
RECOUNT:=0; 12652500
END; 12653000
RECOUNT:=(M[B INX 17] INX NOT RECOUNT).[CF]; 12653500
P(18); 12654000
END; 12654500
% 12654900
% FIX UP INREC, BUILD IO DESC AND QT MESSAGE AS NEXT TO BE WRITTEN. 12654910
% 12654920
P(T:=B INX P(XCH)); 12655000
INREC:=INREC&P(XCH)[CTC]; 12655500
M[T-1]:=(RECOUNT+1)&74[11:41:7]&(V!22)[29:44:4]; 12656000
NT1:=P; % LEFT AT 12626500 12656500
STREAM(A:=NT1.[9:24], C:=NT1.[2:1], PNCH:=V=22, B:=T-18); 12657000
BEGIN DS:=16 LIT"<<<<<<<<<<<<<<< "; 12657500
CI:=CI+PNCH; GO TO PRNT; DS:=7 LIT" PUNCH"; GO TO L1; 12658000
PRNT:DS:=7 LIT"PRINTER"; 12658500
L1: DS:=21 LIT" BACK UP FILE SPACED "; 12659000
CI:=CI+C; GO TO FER; DS:=4 LIT"BACK"; GO TO L2; 12659500
FER: DS:=4 LIT" FOR"; 12660000
L2: DS:=4 LIT"WARD"; 12660500
SI:=LOC A; DS:=6 DEC; B:=DI; DI:=DI-6; 12661000
DS:=5 FILL; DI:=B; 12661500
CI:=CI+PNCH; GO TO LIN; DS:=5 LIT" CARD"; GO TO L3; 12662000
LIN: DS:=5 LIT" LINE"; 12662500
L3: DS:=17 LIT"S. >>>>>>>>>>>>>>"; 12663000
B:=DI; SI:=B; SI:=SI-8; DS:=7 WDS; 12663500
END; 12664000
GO RETURNTRUE; 12664500
12664900
INITIALIZE: 12665000
12665100
% HANDLES MISCELLANEOUS SETUP TASKS, INCLUDING STARTING THE TIMING FOR12665110
% LOGGING, CHECKING AND READYING THE INPUT FILE AND SPREADING COMMON. 12665120
% 12665130
RCW.[CF]:=P(.COM19,LOD) INX 1; 12665500
$ SET OMIT = NOT RJE 12665750
V:=COMMON.[VF]; 12667750
IF P(.INREC,LOD)=0 THEN 12668000
BEGIN 12668250
$ SET OMIT = NOT RJE 12668500
BEGIN 12669250
IF LABELTABLE[V].[1:5]!@21 THEN % PRINTER CL-ED 12669500
BEGIN 12669750
IF (UNIT:=COMMON.[UNITF])<16 THEN 12670000
IF LABELTABLE[UNIT]=@2100000060606060& 12670250
TINU[V][6:30:18] THEN SETNOTINUSE(UNIT,0); 12670500
GO TO INITIATE; 12670750
END; 12671000
LABELTABLE[C].[5:1]:=0; 12671250
END; 12671500
PRT[P1MIX,@25]:=0; 12672000
P:=(GETSPACE[91,IOBUFFERAREAV,1)+2)&90[8:38:10];% %167-12672500
END; 12673000
$ SET OMIT = NOT RJE 12673500
RDCTABLE[V].[8:6]:=P1MIX; 12675000
STARTIMING(5,V); 12675250
STARTIMING(0,UNIT:=COMMON.[UNITF]); 12675500
FPB:=PRT[P1MIX,3]; 12675750
COPY:=COMMON.[COPYF]; 12676000
IF UNIT=18 THEN 12676500
BEGIN 12677000
MFID:=IF V=22 THEN "PUD " ELSE "PBD "; 12677500
$ SET OMIT = NOT RJE 12678000
FIRSTFID:=LABELTABLE[V].[6:42]; 12679500
$ SET OMIT = NOT PACKETS 12680000
IF NOT COMMON.[NOTP] THEN BEGIN PCOPY:=COPY; COPY:=0 END; 12680250
PFIRSTFID:= 12680500
$ POP OMIT 12681000
FID:=FIRSTFID; 12681500
SEARCHVAL:=3; 12682000
IF FINDFILE THEN GO RETURNFALSE; 12682500
END ELSE 12684000
BEGIN 12684500
ABORTED:=0; 12686000
NOCONT:=((NUM:=COMMON.[NUMF]) OR COPY)!0; 12686500
MFID:=MULTITABLE[UNIT]; 12687000
IF LABELTABLE[UNIT].[1:5]!@21 THEN % UNIT WAS CL-ED WHILE 12687300
BEGIN ABORTED:=2; % WE WERE SCHEDULED. 12687400
GO RETURNFALSE; 12687500
END; 12687600
FID:=LABELTABLE[UNIT]:=(*P(DUP))&0[5:47:1]; 12687700
RDCTABLE[UNIT].[8:6]:=P1MIX; 12688000
RDYTAPE; 12689000
IF SPACETOFILE THEN 12690500
BEGIN 12691000
IF T=3 THEN INVALIDNUM; % SET BY READTAPE IF EOT. 12691500
GO RETURNFALSE; 12692000
END; 12692500
END; 12693000
SETUPINREC; 12693500
GO RETURNTRUE; 12694000
12694400
STARTANEWFILE: 12694500
12694600
% HANDLES THE END OF A FILE AND FIGURES OUT WHAT TO DO NEXT. BUT 12694610
% FIRST, THE LOG MUST BE TAKEN CARE OF. (DONT USE T BETWEEN HERE AND 12694620
% THE TEST AT 12705750.) 12694630
% 12694640
IF ABORTED=2 THEN GO TO TAPECL; 12694800
IF SIGNEDON THEN 12695000
BEGIN 12695500
LOGINFO[12]:=-P(DUP)+PROCTIME[P1MIX]+CLOCK+P(RTR); 12696000
LOGINFO[13]:=IOTIME[P1MIX]-(IOTIME[P1MIX]:=LOGINFO[13]); 12696500
OLDIDLETIME:=OLDIDLETIME+LOGINFO[12]; 12697000
PROCTIME[P1MIX]:=*P(DUP)-LOGINFO[12]; 12697500
IDLETIMER; 12698000
LOGINFO[14]:=JAR[P1MIX,7]-(JAR[P1MIX,7]:=LOGINFO[14]); 12698500
LOGINFO[17]:=XCLOCK+P(RTR); 12699000
LOGINFO[18]:=(DSED|2)&DATE[1:18:30]; 12699500
LOGINFO[23]:=FPB[3]&TINU[UNIT][24:18:12]; 12700000
LOGINFO[28]:=FPB[8]&TINU[V][24:18:12]&FORMTOG[42:47:1]; %750-12700500
TINU[UNIT].[18:12]:=0; TINU[V].[18:12]:=0; 12701000
SIGNEDON:=LOGINFO[24]+CLOCK+P(RTR); 12701500
LOGINFO[24]:=LOGINFO[29]:=SIGNEDON; 12702000
FPB[4]:=(*P(DUP))-SIGNEDON; 12702500
FPB[9]:=(*P(DUP))-SIGNEDON; 12703000
LOGSPACE([LOGINFO[0]],30); 12703500
FORGETSPACE(LOGINFO); 12704000
SIGNEDON:=0; 12704500
END; 12705000
% 12705100
% IF DSED OR QTED, SKIP THE CHECKS FOR COPIES. 12705110
% 12705120
IF (TERMFLAG:=DSED OR QTED|3) THEN 12705250
IF V=22 THEN GO TO PNCHDS ELSE GO TO PRNTDS; 12705500
% 12705600
% T IS SET IF THE FIRST GET FAILS. THIS SHOULD ONLY HAPPEN AT THE END 12705610
% OF A BACK-UP TAPE. NOTE THAT IF A FILE NUMBER IS SPECIFIED, INITIAL-12705620
% IZE ONLY SPACES TO ITS START, SO WE MAY CATCH AN INVALID NUMBER 12705630
% HERE. SINCE ONLY ONE FILE IS PRINTED WHEN A NUMBER IS GIVEN, IF WE 12705640
% ARRIVE HERE, IT MUST HAVE BEEN A BAD NUMBER. IF IT IS DESIRED TO 12705650
% CONTINUE DOWN THE TAPE AFTER THE SPECIFIED FILE, THIS TEST WILL NEED12705660
% TO BE CHANGED. 12705670
% 12705680
IF T THEN % FIRST GET FAILED 12705750
IF UNIT!18 THEN 12706000
BEGIN 12706250
IF COMMON.[NUMF]!0 THEN INVALIDNUM; 12706500
GO TO TAPEND; 12706750
END ELSE GO REMOVEM; 12707000
% 12707100
IF (COPY:=COPY-1) GTR 0 THEN % MORE COPIES OF FILE RQD. 12707250
BEGIN 12707500
IF V=22 AND PUNCHLCK THEN 12707750
BEGIN 12708000
PUNCHLK: STREAM(P1MIX, T:=T:=SPACE(10)); 12708250
BEGIN DS:=25 LIT"#PNCH LOCKED;PRNPBT/DISK="; 12708500
SI:=LOC P1MIX; DS:=2 DEC; DS:=LIT"~"; 12708750
DI:=DI-3; DS:=FILL; 12709000
END; 12709250
SPOUT(T); 12709500
REPLY[P1MIX]:=NABS(T:=VOK&VWY[36:42:6]&VQT[30:42:6]); 12709750
COMPLEXSLEEP(REPLY[P1MIX]>0 OR DSED); 12710000
IF NOT WHYSLEEP(T) THEN GO TO PNCHLK; 12710250
IF DSED OR QTED THEN GO STARTANEWFILE; 12710500
END; 12710750
IF UNIT=18 THEN % DISK 12711000
BEGIN 12711250
$ SET OMIT = NOT PACKETS 12711500
IF NOT STOG THEN STOG:=SEARCHVAL=3; 12712000
$ POP OMIT 12712500
PRINTITAGAIN: 12713000
FID:=FIRSTFID; 12713500
SEARCHVAL:=5; 12714000
IF FINDFILE THEN GO TO EOF ELSE GO TO CONTINUE; 12714500
END; 12715000
% % TAPE 12715400
IF RDCTABLE[UNIT].[14:10]!1 THEN % THIS ISNT FIRST REEL 12715500
BEGIN 12716000
RDCTABLE[UNIT].[14:10]:=0; 12716500
IF NOT LOOKFORTAPE THEN GO TO EOF; 12717000
END ELSE 12717500
RDYTAPE; 12718000
IF SPACETOFILE THEN GO TO EOF ELSE GO TO CONTINUE; 12718500
END; 12719000
$ SET OMIT = NOT PACKETS 12719500
IF UNIT=18 THEN % CHECK FOR COPIES OF PACKET 12720000
BEGIN 12720500
IF STOG THEN BEGIN SEARCHVAL:=3; STOG:=0 END; 12721000
IF NOMOREFILES THEN 12721500
IF (PCOPY:=PCOPY-1) GTR 0 THEN 12722000
BEGIN 12722500
FIRSTFID:=PFIRSTFID; 12723000
GO PRINTAGAIN; 12723500
END ELSE 12724000
ELSE GO CONTINUE; 12724500
END; 12725000
$ POP OMIT 12725500
12725900
EOF: 12726000
12726100
% AT THIS POINT, WE ARE THROUGH WITH THIS FILE OR PACKET. CLEAN UP 12726110
% THE OUTPUT BEFORE COING ON. 12726120
% 12726130
PRNTDS: 12728000
PNCHDS: 12740000
IF UNIT!18 THEN % TAPE 12740500
BEGIN 12741000
IF TERMFLAG OR NOCONT OR ABORTED THEN 12741500
BEGIN 12742000
TAPEND: 12742500
REWIND; 12743000
GO TO TEST; 12743500
END ELSE 12744000
BEGIN % TRY THE NEXT FILE 12744500
NUM:=NUM+1; 12745000
RECOUNT:=@77777; 12745500
CONTINUE: SETUPINREC; 12746000
RETURNFALSE: 12746500
P(0); 12747000
GO RETURNTOCOM19; 12747500
END; 12748000
END; 12748500
12748900
REMOVEM: 12749000
12749100
% DISK - CLOSE THE OPENED FILES AND, IF NOT QTED, REMOVE THEM. 12749110
% 12749120
IOD:=IF SEARCHVAL=3 THEN FID ELSE NOT 0; 12749500
SEARCHVAL:=13; REMOVEIT; 12750000
FPB[4]:=(*P(DUP))+CLOCK+P(RTR); 12750250
IF TERMFLAG!3 THEN % NOT QT-ED 12750500
BEGIN 12751000
IOD:=NOT 0; 12751500
SEARCHVAL:=7; REMOVEIT; 12752000
TEST: % FOR CONTINUATION FOR AUTOPRINT OR RJE. 12752500
IF AUTOPRINT AND NOT (FORMTOG OR TERMFLAG) AND 12753000
(TWO(V) AND SAVWORD)=0 12753500
$ SET OMIT = NOT RJE 12753750
THEN 12755000
IF (COMMON:=PRINTORPUNCHWAIT(-V,-STA))!0 THEN GO TO STOPTIME;12755500
END; 12756000
TAPECL: 12756400
COMMON:=0; 12756500
FORGETSPACE(B); 12757000
$ SET OMIT = NOT RJE 12757350
SETNOTINUSE(V,FORMTOG); 12757500
STOPTIME: 12757750
STOPTIMING(5,1023); 12758000
RETURNTRUE: 12758250
P(1); 12758500
RETURNTOCOM19: 12759000
P(0,RDS,1,SUB,0,XCH,CFX,STF); 12759500
END OF FIRST PRINTER BACKUP SPECIAL CASES PROCEDURE; 12760000
PROCEDURE PRNPBTSPECASE2(Z); 12800000
% 12800100
% THIS PROCEDURE HANDLES ADDITIONAL THINGS FOR COM19. VALUES OF Z ARE:12800110
% 0 INITIALIZE LOGGING. 12800120
% 1 WRITE ABORT OR DSED MESSAGE AND CONSTRUCT ENDING LABEL. 12800130
% 2 HANDLE PARITY ON INPUT FILE. 12800140
% 12800150
VALUE Z; REAL Z; 12800500
BEGIN 12801000
REAL RCW=+0, MSCW=-2, COMMON=-4; 12801500
ARRAY INREC=+1[*]; 12802000
ARRAY FPB=INREC+1[*], LOGINFO=FPB+1[*], HEADER=LOGINFO+1[*]; 12802500
REAL UNIT=HEADER+1, V=UNIT+1, COPY=V+1, MFID=COPY+1, FID=MFID+1, 12803000
IOD=FID+1, T=IOD+1, B=T+1; 12803500
REAL SEARCHVAL=B+1, CURROW=SEARCHVAL+1, FIRSTFID=CURROW+1, 12804000
SEGNR=FIRSTFID+1; 12804500
REAL X=SEARCHVAL, NUM=CURROW, RECOUNT=SEGNR; 12805000
BOOLEAN SIGNEDON=SEGNR+1, FORMTOG=SIGNEDON+1, ABORTED=FORMTOG+1; 12805500
BOOLEAN NOCOUNT=FIRSTFID; 12806000
$ SET OMIT = NOT PACKETS 12806500
BOOLEAN STOG=ABORTED+1; 12807000
REAL PCOPY=STOG+1, PFIRSTFID=PCOPY+1; 12807500
$SET OMIT = NOT (RJE AND PACKETS) 12808000
$ SET OMIT = PACKETS 12809500
12812000
LABEL SLEAP, WHY, EXITTOCOM19; 12812500
LABEL SIGNIN, ABORTMSG, PARERR; 12813000
SWITCH SW := 12813500
SIGNIN, ABORTMSG, PARERR; 12814000
DEFINE DSED = TERMSET(P1MIX)#, 12814500
QTED = (PRT[P1MIX,@25]!0)#, 12815000
VF = 43:5#, 12815100
UNITF = 38:5#, 12815200
COPYF = 30:8#, 12815300
NUMF = 22:8#, 12815400
NOTP = 29:1#, 12815500
COPY0 = 21:1#; 12815600
12815900
%***********************************************************************12816000
12816500
SUBROUTINE IDELTIMER; 12817000
BEGIN 12817500
STOPLOG(P1MIX,1); 12817600
P(P1MIX); P1MIX:=0; 12818000
IDLETIME; 12818500
P1MIX:=P; 12819000
$ SET OMIT = NOT(NEWLOGGING) 12819399
STARTLOG(P1MIX); 12819500
END IDLETIMER; 12820000
12820500
%***********************************************************************12821000
12821500
SUBROUTINE FM; %% BUILD AND SPOUT FORMS MESSAGE %% 12822000
BEGIN 12822500
STREAM(U:=TINU[V], P1MIX, INREC, D:=T:=SPACE(10)); 12823000
BEGIN DS:=LIT"#"; 12823500
SI:=LOC U; SI:=SI+5; DS:=3 CHR; 12824000
DS:=20 LIT" FM RQD:PRNPBT/DISK="; DS:=2 DEC; 12824500
U:=DI; DI:=DI-2; DS:=FILL; DI:=U; 12825000
SI:=INREC; DS:=5 LIT" FOR "; 12825500
SI:=SI+1; DS:=7 CHR; DS:=LIT"/"; 12826000
SI:=SI+1; DS:=7 CHR; DS:=4 LIT" OF "; 12826500
SI:=SI+1; DS:=7 CHR; DS:=LIT"/"; 12827000
SI:=SI+1; DS:=7 CHR; 12827500
DS:=LIT"~"; 12828000
END; 12828500
SPOUT(T); 12829000
REPLY[P1MIX] := 12829500
NABS(T:=VOK&VWY[36:42:6]&VQT[30:42:6]&VFM[24:42:6]); 12830000
END FM SUBROUTIN; 12830500
12831000
%***********************************************************************12831500
SUBROUTINE BADFM; %BUILD AND SPOUT BAD FM MESSAGE % 12832000
BEGIN 12832500
STREAM(A:=TINU[T],MX:=P1MIX,T:=T:=SPACE(10)); 12833000
BEGIN DS:=19 LIT"INVALID INPUT UNIT "; 12833500
SI:=LOC MX; DS:=2 DEC;DS:=2 LIT"FM"; 12834000
SI:=LOC A; SI:=SI+5; DS:=3 CHR; 12834500
DS:=LIT "~"; DI:=DI-8; DS:=FILL; 12835000
END; 12835500
SPOUT(T); 12836000
END BADFM SUBROUTINE; 12836500
12837000
%***********************************************************************12837500
12838000
SUBROUTINE WRITEBANDEJECT; 12838500
BEGIN 12839000
$ SET OMIT = NOT RJE 12839500
BEGIN 12842500
P(WAITIO(B INX @210104000000,0,V),DEL); 12843000
IF V!22 THEN % %150-12843500
IF SEPARATE THEN P(WAITIO(@4000100000,0,V),DEL) %150-12843600
ELSE P(WAITIO(@4002000000,0,V),DEL);%150-12843700
END; 12844000
END; 12844500
12845000
%***********************************************************************12845500
12846000
% 12846500
P(Z,MSCW,STF); 12847000
GO TO SW[P]; 12847500
12847600
SIGNIN: 12848000
12848100
% HANDLES FIRST RECORD OF FILE, PICKING UP LOGGING INFO AS WELL AS 12848110
% COPIES OR FORM SPECIFICATIONS. NOTE THAT LABEL INFO IS SAVED IN 12848120
% LOGARRAY FOR USE AT ABORTMSG. TIMING IS STARTED AT INITIALIZE AND 12848130
% STOPPED IN REWIND, AT REMOVEM OR AT STOPTIME FOR TAPE, DISK AND THE 12848140
% OUTPUT UNIT RESPECTIVELY. LOGARRAY IS USED TO REMOVE THE TIME 12848150
% ASSOCIATED WITH A GIVEN BACK UP FILE FROM THE TIMING IN THE FPB AND 12848160
% LOG IT TO THE USER. THAT IS DONE IN SIGNOUT. THUS, THE TIME LOGGED 12848170
% AT PRNPBT/DISK EOJ IS OVERHEAD TIME OCURRING DURING SWITCHING FROM 12848180
% FILE TO FILE. 12848190
% 12848200
LOGINFO := SAVEARRAYDESC(31,LOGAREAV); %167-12848500
IF FORMTOG:=INREC[13] THEN FM; 12849000
IF COPY LEQ 0 AND NOT COMMON.[COPY0] THEN 12849500
COPY:=IF (INREC[14] AND NOT @377)=0 THEN INREC[14]+1 ELSE 0; 12850000
LOGINFO[0]:=3; 12850500
STREAM(S:=[INREC[4]],D:=[LOGINFO[1]]); 12851000
BEGIN SI:=S; DS:=9 WDS; END; 12851500
LOGINFO[10]:=5; 12852000
LOGINFO[11]:=2; 12852500
LOGINFO[12]:=-(PROCTIME[P1MIX]+CLOCK+P(RTR)); 12853000
LOGINFO[13]:= IOTIME[P1MIX]; 12853500
IDLETIMER; LOGINFO[14]:=JAR[P1MIX,7]; 12854000
LOGINFO[15]:=DATE; 12854500
LOGINFO[16]:=XCLOCK+P(RTR); 12855000
LOGINFO[19]:=INREC[15]; %132-12855500
LOGINFO[20]:="PRINTER"; 12856000
LOGINFO[21]:="BACK-UP"; 12856500
LOGINFO[22]:=LOGINFO[27]:=0; 12857000
LOGINFO[24]:=-CLOCK-P(RTR); 12857500
LOGINFO[25]:=INREC[0]; % SAVE LABEL INFO FOR ABORT 12858000
LOGINFO[26]:=INREC[1]; 12858500
LOGINFO[28]:=M[INREC INX NOT 14]; 12859000
LOGINFO[29]~INREC[2]; 12859500
LOGINFO[30]~INREC[3]; 12860000
RDCTABLE[V].[47:1]~INREC[0]="FULLPGE"; % LINES66 OPTION %724-12860100
IF FORMTOG THEN 12860500
SLEAP: 12861000
BEGIN COMPLEXSLEEP(REPLY[P1MIX] GEQ 0 OR DSED OR QTED); 12861500
IF NOT WHYSLEEP(I) THEN 12862000
BEGIN FM; GO TO SLEAP END; 12862500
IF REPLY[P1MIX].[CF]=VFM THEN 12863000
IF (T:=REPLY[P1MIX].[FF]) NEQ 20 AND T NEQ 21 THEN 12863500
BEGIN % ILLEGAL UNIT. 12864000
LABELTABLE[T]:=@114; 12864500
BADFM; 12865000
READY:=READY AND (T:=NOT TWO(T)); 12865500
RRRMECH:=RRRMECH AND T; 12866000
SAVEWORD:=SAVEWORD AND T; FM; GO SLEAP 12866500
$ SET OMIT = NOT(RJE AND DATACOM ) 12867000
END ELSE 12873000
IF T!V THEN 12873500
BEGIN % SWITCH UNITS. 12874000
LABELTABLE[T] := LABELTABLE[V]; 12874500
RDCTABLE[T] := RDCTABLE[V]; 12875000
MULTITABLE[T] := MULTITABLE[V]; 12875500
LABELTABLE[V] := MULTITABLE[V] := RDCTABLE[V] := 0; 12876000
FPB[8].[36:6]:=(V:=T)+1; 12876500
END; 12877000
END; 12877500
FORMTOG:=(FORMTOG OR PUNCHLCK AND V=22) AND NOT (DSED OR QTED); 12878000
SIGNEDON:=TRUE; 12878500
GO EXITTOCOM19; 12879000
12879100
ABORTMSG: 12879500
12879600
% ABORTED=3 IMPLIES ABORT HAS OCCURRED. CURRENTLY, NOTHING ATTEMPTS TO12879610
% DISTINGUISH BETWEEN 1 AND 3, BUT ABORTED MUST BE SET HERE FOR TAPE 12879620
% SO WHY NOT MAKE IT DIFFERENT. 12879630
% 12879640
ABORTED:=3; 12880000
STREAM(T:=DSED OR QTED, B); 12880500
BEGIN 12881000
DS:=8 LIT"#"; SI:=B; DS:=16 WDS; DI:=B; 12881500
CI:=CI+T; GO TO AB; 12882000
DI:=DI+24; 12882500
DS:=34 LIT" BACK-UP TERMINATED BY OPERATOR "; 12883000
GO TO LEND; 12883500
AB: DI:=DI+34; DS:=11 LIT" ABORTED "; 12884000
LEND: 12884500
END; 12885000
WRITEBANDEJECT; 12885500
IF V!22 AND SIGNEDON THEN 12886000
BEGIN 12886500
STREAM(S~[LOGINFO[1]],T~0,B); 12887000
BEGIN DS~ 8LIT" LABEL "; SI~S; 24(SI~SI+8); DS~16CHR; 12887500
SI~SI+8; DS~8CHR; T~SI; SI~S; DS~9WDS; SI~T; 12888000
SI~SI+1; DS~LIT" "; DS~7CHR; DS~LIT"/"; DI~SI+1; DS~7CHR;12888500
DS~ 12 LIT " "; 12889000
END; 12889500
WRITEBANDEJECT; 12890000
IF NOT SEPARATE THEN P(WAITIO(@4000100000,0,V),DEL); %150-12890100
END; 12890500
GO TO EXITTOCOM19; 12891000
12891100
PARERR: 12891500
12891600
% BUILDS ERROR MESSAGE FOR OUTPUT AND ALLOWS OPERATOR TO OK OR DS. 12891610
% T IS USED TO PASS BACK WHETHER OR NOT TO TERMINATE. 12891620
% 12891630
IF V=22 THEN GO TO WHY; 12892000
STREAM(A:=UNIT, T:=T:=SPACE(15)); 12892500
BEGIN 22(DS:=2 LIT ">>");SI:=LOC A;SI:=SI+7; 12893000
IF SC="B" THEN DS:=6 LIT " DISK " ELSE 12893500
DS:=6 LIT " TAPE "; 12894000
DS:=26 LIT "PARITY ON PRINTER BACK UP "; 12894500
22(DS:=2 LIT ">>"); 12895000
END STREAM; 12895500
$ SET OMIT = NOT(RJE AND DATACOM ) 12896000
P(WAITIO(T&16[CTF],0,V),DEL); 12897500
FORGETSPACE(T); 12898000
WHY: 12898500
FILEMESS("#PARITY",0,0,"ERROR ",0,0,0); 12899000
REPLY[P1MIX]:=-VQT&VWY[36:42:6]&VOK[30:42:6]; 12899500
COMPLEXSNOOZE(MIXMAX,REPLY[P1MIX] GEQ 0 OR DSED OR QTED); 12900000
IF NOT WHYSLEEP(VQT&VWY[36:42:6]&VOK[30:42:6]) THEN GO TO WHY; 12900500
T:=DSED OR QTED; 12901000
EXITTOCOM19: 12901500
P(0,RDS,0,XCH,CFX,STF); 12902000
END OF SECOND GROUP OF PRINTER BACKUP SPECIAL CASES; 12902500
PROCEDURE COM19; 13000000
% 13000100
% COM19, TOGETHER WITH PRNPBTSPECASE1 AND PRNPBTSPECASE2 WHICH SHARE 13000110
% ITS STACK, ARE THE WORKING PART OF PRINTER BACK-UP. INFORMATION IS 13000120
% PASSED TO COM19 IN COMMON AND LABELTABLE, AS FOLLOWS: 13000130
% COMMON.[43:5] LOGICAL UNIT NUMBER OF OUTPUT UNIT. 13000140
% [38:5] INPUT UNIT NUMBER. IF DISK, THE LABELTABLE ENTRY FOR 13000160
% THE OUTPUT UNIT CONTAINS THE FILE ID. 13000170
% [30:8] NUMBER OF COPIES SPECIFIED IN PB MESSAGE. 13000180
% [22:8] IF TAPE, STARTING FILE NUMBER GIVEN IN PB MESSAGE. 13000190
% IF DISK, =0 IF ENTIRE PACKET IS TO BE PRINTED, =1 IF 13000200
% NOT. 13000210
% [21:1] ON IF "=0" APPEARED IN PB MESSAGE. 13000215
% FOR RJE, COMMON IS THE ADDRESS OF A TWO WORD ARRAY. THE FIRST WORD 13000220
% CONTAINS THE INFORMATION DESCRIBED ABOVE AND THE SECOND CONTAINS THE13000230
% FILE ID FOR DISK (WHICH IS IN LABELTABLE FOR NON-RJE FILES). 13000240
% 13000250
BEGIN 13001000
REAL RCW=+0, COMMON=-4; 13002000
ARRAY INREC[*], FPB[*], LOGINFO[*], HEADER[*]; 13003000
REAL UNIT, V, COPY, MFID, FID, IOD, T, B; 13004000
REAL SEARCHVAL, CURROW, FIRSTFID, SEGNR; 13005000
REAL X=SEARCHVAL, NUM=CURROW, RECOUNT=SEGNR; 13006000
BOOLEAN SIGNEDON, FORMTOG, ABORTED; 13007000
BOOLEAN NOCONT=FIRSTFID; 13008000
$ SET OMIT = NOT PACKETS 13009000
BOOLEAN STOG; 13010000
REAL PCOPY, PFIRSTFID; 13011000
$ SET OMIT = PACKETS 13012000
$ SET OMIT = NOT RJE 13015000
% 13017100
% THE LOCAL VARIABLES ARE USED AS FOLLOWS: 13017110
% ARRAYS 13017120
% INREC ARRAY DESCRIPTOR FOR THE CURRENT RECORD. 13017130
% FPB FPB ARRAY. INPUT IS THE FIRST FILE; OUTPUT THE 2ND. 13017140
% LOGINFO ARRAY IN WHICH THE LOG ENTRY IS BUILT. THE FIRST TEN 13017150
% WORDS ARE THE CONTROL CARD ENTRY; THE NEXT 10, THE 13017160
% PRINTER BACK-UP ENTRY AND THE LAST 10, THE FILE ENTRIES.13017170
% HEADER DISK FILE HEADER. 13017180
% REALS 13017190
% UNIT LOGICAL UNIT NUMBER FOR INPUT. 13017200
% V LOGICAL UNIT NUMBER FOR OUTPUT. 13017210
% COPY NUMBER OF COPIES OF THIS FILE TO BE PRINTED. IF IT IS 13017220
% NOT SPECIFIED, IT EQUALS 0. 13017230
% MFID MULTI-FILE ID OF INPUT FILE. 13017240
% FID FILE ID OF INPUT FILE. 13017250
% IOD, T TEMPORARY STORAGE. 13017260
% B ADDRESS OF 90 WORD BUFFER FOR INPUT. 13017270
% BOOLEANS 13017280
% SIGNEDON ON IF LOGGING IS INITIALIZED. THIS SHOULD BE OFF ONLY 13017290
% FOR FILES WHICH DO NOT START AT THE BEGINING, E.G., 13017300
% WHEN A STARTING REEL IS SPECIFIED ON DISK. 13017310
% FORMTOG ON IF FORM IS SPECIFIED OR PNCHLOCK IS SET. 13017320
% ABORTED =1, DISK ABORTED BY H/L. CHECK IN GET TO FIND OUT WHERE.13017330
% =2, TERMINATION DUE TO CL OF INPUT TAPE WHILE SCHEDULED.13017335
% =3, TAPE ABORTED BY H/L. FOUND BY RECOUNT MISMATCH. 13017340
% 13017350
% THE FOLLOWING APPLY ONLY TO DISK FILES: 13017360
% SEARCHVAL THIRD PARAMETER FOR DIRECTORYSEARCH. IT IS 3 OR 5 DURING13017370
% PRINTING, DEPENDING ON WHETHER IT IS THE FIRST COPY OR 13017380
% NOT, AND 13 OR 7 DURING FILE TERMINATION. 13017390
% CURROW INDEX OF THE ROW CURRENTLY BEING PRINTED. 13017400
% FIRSTFID FILE ID OF FIRST REEL, USED FOR MULTIPLE COPIES OF 13017410
% MULTI-REEL FILES. 13017420
% SEGNR NUMBER OF NEXT SEGMENT TO READ FROM THE CURRENT ROW. 13017430
% 13017440
% THE FOLLOWING APPLY ONLY TO TAPES: 13017450
% X TEMPORARY STORAGE. 13017460
% NUM NUMBER OF CURRENT FILE ON TAPE, USED FOR COPIES. 13017470
% RECOUNT NUMBER OF RECORDS PRINTED IN THIS FILE. THIS IS CHECKED 13017480
% AGAINST THE C-FIELD OF THE IO DESCRIPTORS IN THE FILE TO13017490
% SPOT ABORTS. 13017500
% NOCONT TRUE IF CONTINUATION FROM FILE TO FILE IS NOT ALLOWED. 13017510
% 13017520
% THE FOLLOWING APPLY ONLY TO PACKETS: 13017530
% PCOPY NUMBER OF COPIES FROM PB MESSAGE, WHICH MAY APPLY TO THE13017540
% ENTIRE PACKET. "COPY" IS SET ONLY FROM LABEL EQUATION. 13017550
% PFIRSTFID FILE ID OF FIRST FILE IN THE PACKET, USED FOR COPIES OF 13017560
% THE PACKET. FIRSTFID APPLIES TO INDIVIDUAL FILES WITHIN 13017570
% THE PACKET AND IS USED FOR COPIES SPECIFIED VIA LABEL 13017580
% EQUATION. 13017590
% STOG SET DURING THE FIRST PRINTING OF THE PACKET IF ONE OF 13017600
% THE FILES SPECIFIES MULTIPLE COPIES. IT IS USED TO 13017610
% RESTORE THE VALUE OF 3 TO SEARCHVAL WHEN THE FILE IS 13017620
% COMPLETED. 13017630
% 13017640
% THE FOLLOWING APPLIES ONLY TO RJE: 13017650
% STA TERMINAL UNIT AND BUFFER NUMBER OF THE RJE TERMINAL. 13017660
% 13017670
LABEL TRYNEXT, TAPERDR, TAPERD, TAPECHK, ABORT, NOGET, GOTTEN, 13018000
START, RESTART, MAINLOOP, GOTIT, QUIT, TESTEND; 13019000
DEFINE DSED = TERMSET(P1MIX)#, 13020000
QTED = (PRT[P1MIX,@25]!0)#; 13021000
DEFINE LINECT = LOGINFO[27]#; % %750-13021900
DEFINE LOOKFORTAPE = PRNPBTSPECASE1(0)#, 13022000
NOMOREREELS = PRNPBTSPECASE1(1)#, 13023000
QTSPEC = P(PRNPBTSPECASE1(2),DEL)#, 13024000
INITIALIZE = PRNPBTSPECASE1(3)#, 13025000
STARTANEWFILE = PRNPBTSPECASE1(4)#, 13026000
SIGNIN = PRNPBTSPECASE2(0)#, 13027000
ABORTMSG = PRNPBTSPECASE2(1)#, 13028000
PARERR = PRNPBTSPECASE2(2)#; 13029000
13030000
%***********************************************************************13031000
13032000
BOOLEAN SUBROUTINE GET; 13033000
BEGIN 13034000
IF INREC[17].[20:1] THEN GO TO NOGET; 13035000
IF (INREC:=(NOT 17) INX INREC).[CF] GEQ B.[CF] THEN 13036000
IF UNIT!18 THEN GO TO TAPECHK ELSE 13037000
ELSE % READ NEXT BLOCK 13038000
IF UNIT=18 THEN 13039000
BEGIN 13040000
IF SEGNR > HEADER[7]|3 THEN GO TRYNEXT; % END OF FILE 13041000
IF (SEGNR GEQ HEADER[8]-1) THEN 13042000
BEGIN % END OF ROW 13043000
IF (CURROW:=CURROW+1) GEQ HEADER[9].[43:5]+10 THEN 13044000
TRYNEXT: IF NOMOREREELS THEN GO TO NOGET; 13045000
SEGNR:=0; 13046000
END; 13047000
INREC:=90 INX INREC; 13048000
DISKIO(IOD,-B,90,HEADER[CURROW]+SEGNR); 13049000
SEGNR:=SEGNR+3; 13050000
SLEEP([IOD],IOMASK); 13051000
IF IOD.[28:1] THEN 13052000
BEGIN PARERR; 13053000
IF T THEN GO TO NOGET; % DSED OR QTED 13054000
END; 13055000
IF ABORTED THEN % TEST FOR BAD IO DESC. 13056000
IF (M[B INX 18].[6:42] EQV " ")=NOT 0 THEN 13057000
GO ABORT; 13058000
END ELSE 13059000
BEGIN % TAPE 13060000
TAPERDR: X:=0; 13061000
TAPERD: IF (IOD:=WAITIO(B,@2000040,UNIT)).[43:1] THEN 13062000
BEGIN PARERR; 13063000
IF T THEN GO TO NOGET; % DSED OR QTED 13064000
END; 13065000
IF IOD.[42:1] OR X THEN 13066000
BEGIN 13067000
IF (X:=NOT X) THEN GO TO TAPERD; 13068000
IF M[B INX 3] THEN 13069000
IF LOOKFORTAPE THEN GO TO TAPERDR ELSE GO NOGET; 13070000
END; 13071000
IF (X:=M[B INX NOT 0])!90 THEN 13072000
IF (X AND @7775)=16 THEN % OLD FORMAT TAPE 13073000
BEGIN 13074000
INREC.[CF]:=B INX 1; 13075000
INREC[17]:=M[B]&0[20:20:7]; 13076000
END ELSE GO TO NOGET 13077000
ELSE 13078000
BEGIN 13079000
INREC:=90 INX INREC; 13080000
IF RECOUNT=@77777 THEN RECOUNT~INREC[17].[CF] ELSE 13080100
TAPECHK: IF (RECOUNT:=RECOUNT INX 1) ! INREC[17].[CF] THEN 13081000
BEGIN 13082000
ABORT: ABORTMSG; 13083000
NOGET: P(0); 13084000
GO TO GOTTEN; 13085000
END; 13086000
END; 13087000
END; 13088000
P(1); 13089000
GOTTEN: GET:=P; 13090000
END; 13091000
% -13091500
%%%%% START OF CODE %%%%% -13091600
% 13092000
% START IS USED FOR A NEW FILE (OR NEW PACKET), RESTART ISUSED FOR 13092010
% A COPY (OR A NEW FILE WITHIN A PACKET). 13092020
13092030
START: 13093000
IF COMMON=0 THEN GO TO INITIATE; 13094000
IF INITIALIZE THEN 13095000
BEGIN 13096000
RESTART: IF GET THEN 13097000
BEGIN 13098000
IF INREC[17].[1:11]=0 THEN SIGNIN ELSE GO GOTIT; 13099000
IF UNIT!18 THEN RECOUNT:=INREC[17].[CF]; 13101000
END ELSE % BAD FIRST BLOCK, USUALLY EOT. 13102000
BEGIN P(1); 13103000
GO TO TESTEND; 13104000
END; 13105000
MAINLOOP: 13106000
IF STOPSET(P1MIX) THEN STOPM(0); 13107000
IF (T:=PRT[P1MIX,@25])!0 OR DSED THEN 13108000
BEGIN 13109000
IF T<0 THEN % + OR - SPECIFIED. 13110000
BEGIN 13111000
QTSPEC; 13112000
GO TO MAINLOOP; 13113000
END; 13114000
ABORTMSG; % DSED OR QTED 13115000
GO TO QUIT; 13116000
END; 13117000
IF GET THEN % VALID REC. WRITE IT & CONTINUE 13118000
BEGIN 13119000
GOTIT: 13119100
$ SET OMIT = NOT RJE 13120000
IF V EQL 22 AND INREC[17].[18:1] THEN ELSE %206-13127899
BEGIN % %750-13127990
P(WAITIO(INREC[17]&(INREC)[CTC]&8[21:42:6],0,V),DEL); 13128000
LINECT~*P(DUP) + 1; % %750-13128010
END; % %750-13128020
GO TO MAINLOOP; 13129000
END; 13130000
END; 13131000
QUIT: 13132000
P(0); 13133000
TESTEND: 13134000
P:=P; % I=1 IF FIRST GET FAILS, ELSE 0.13135000
IF STARTANEWFILE THEN GO TO START ELSE GO TO RESTART; 13136000
END OF PRINTING BACKUP TAPE AND DISK FILES; 13137000
$ SET OMIT = NOT(DATACOM ) 13198999
$ SET OMIT = NOT(DATACOM AND RJE ) 13299999
REAL PROCEDURE ANALYSIS;% 14000000
BEGIN% 14001000
REAL ICW,IRCW,INCW,CL,T1,C,T2=SYLLABLE ;% 14002000
$ SET OMIT = NOT(NEWLOGGING) 14002099
LABEL GETOUT;% 14003000
COMMENT ANALYSIS EXAMINS THE SYLLABLE WHICH CAUSED THE INTURRUPT AND% 14004000
FROM THE RELATIVE ADDRESS OF THE SYLLABLE (INCLUDING% 14005000
VARIENT OPERATOR CONSIDERATIONS) COMPUTES THE LOCATION,C, 14006000
OF A COPY OF THE DESCRIPTOR ON THE TOP OF THE STACK.% 14007000
THE PREVIOUS TWO SYLLABLES ARE FETCHED BY THE STREAM% 14008000
STATEMENT GETSYLLABLES WHICH ALSO ADJUSTS THE C-L REGIST- 14009000
ERS PROPERLY.% 14010000
FINALLY THE STACK IS ADJUSTED AS FOLLOWS:% 14011000
DECREASE S BY 1,IF OPDC OR DESC% 14012000
XCH A AND B REGISTERS,IF COC OR CDC% 14013000
OTHERWISE LEAVE THE SAME. ;14014000
CHECKSTACKSPACE;% %WF 14014100
$ SET OMIT = NOT(NEWLOGGING) 14014199
INCW = PRT[P1MIX,8];% 14015000
IF INCW.[CF]<@1777 THEN % SOMETHING VERY WRONG %602-14015200
BEGIN JAR[P1MIX,6].[1:1]~1; % SD BIT %602-14015210
FILEMESS(-"SEE MCP"," PATCH ",0,0,0,0,602)%KLUGE MSG&DS14015220
END; 14015240
POLISH(.INCW,IOR);% 14016000
IRCW ~ * INCW ;% 14017000
ICW ~ *( (NOT 0) INX INCW);% 14018000
CL ~ (IRCW INX 0) & IRCW[30:10:2];% 14019000
STREAM (T1~0,T2~0,CL:X~0);% 14020000
BEGIN% 14021000
SI~CL; SI~SI-2 ; CL ~ SI; DI ~ LOC T2; DI~DI+6;% 14022000
DS ~ 2 CHR; SI ~ SI-3;% 14023000
IF SC = "/" THEN% 14024000
BEGIN% 14025000
SI~SI-1; IF SC ="0" THEN% 14026000
BEGIN TALLY~1; T1~TALLY ;CL ~ SI END;% 14027000
END;% 14028000
END GETSYLLABLE ;% 14029000
POLISH(.CL,~,.T2,~,.T1,~);% 14030000
IF INCW.[32:1] THEN% 14031000
BEGIN COMMENT P-BIT IN CHARACTER MODE ;% 14032000
IF T2 = @4441 THEN% 14033000
BEGIN COMMENT ENTER CHARACTER MODE;% 14034000
P(M[(IRCW ~ *(NOT 0 INX INCW ~ PRT[P1MIX,8] ~% 14035000
(NOT 1 INX INCW)&0[32:1:1])).[18:15]]&% 14036000
1[16:47:1]&0[18:18:15],(NOT 0)INX INCW,~); 14037000
C ~ INCW INX 0 -2;% 14038000
END ELSE BEGIN% 14039000
IF MEMORY[ C ~ IRCW.[18:15]-T2.[36:6]].[1:3] = 4% 14040000
THEN% 14041000
BEGIN% 14042000
IF T2.[42:6]= @53 THEN BEGIN% 14043000
COMMENT CONTROL WORD MEANS CHARACTER MODE RELEASE;% 14044000
T1~PRT[P1MIX,9]~M[(*((NOT 1)INX INCW)).[18:15]].[33:15];% 14045000
POLISH(M[T1],0,0);% 14046000
IF M[T1].[20:1] THEN CONTINUITYBIT;% 14047000
PROGRAMRELEASE;% 14048000
END% 14049000
END;% 14050000
IF T2 = 0 THEN GO TO GETOUT;% 14051000
END% 14052000
END% 14053000
ELSE% 14054000
BEGIN% 14055000
IF T2.[46:1] THEN% 14056000
BEGIN% 14057000
C ~ ICW.[33:15];% 14058000
POLISH(ICW, (NOT 1)INX INCW, ~,IRCW,% 14059000
PRT[P1MIX,8]~INCW ~ (NOT 0)INX INCW ,~);% 14060000
END OPDC DESC PART% 14061000
ELSE% 14062000
BEGIN% 14063000
C ~ INCW INX 0 -2;% 14064000
IF (NT1 ~ T2 AND @77) = @41 THEN% 14065000
BEGIN C ~C-1 ;% 14066000
POLISH(MEMORY[C],MEMORY[C+1],[MEMORY[C]], ~ ,[MEMORY[C+1] 14067000
],~);% 14068000
END COC CDC PART% 14069000
ELSE IF NT1 = @31 THEN% 14070000
BEGIN COMMENT THIS IS A BRANCH;% 14071000
GETOUT: CL ~ P([PRT[P1MIX,1]],DUP,T2,XCH,~) INX @600000;14072000
END BRANCH PART% 14073000
ELSE IF NT1 = @35 THEN GO TO GETOUT; COMMENT RETURN;% 14074000
END ALL SYLLABLES BUT OPDC DESC ;% 14075000
END WORD MODE INTERRUPT ;% 14076000
POLISH(IRCW & CL[33:33:15]&CL[10:30:2],INCW,~) ;% 14077000
ANALYSIS ~ C ;% 14078000
$ SET OMIT = NOT(NEWLOGGING) 14078099
END ANALYSIS OF P BIT ;% 14079000
SAVE INTEGER PROCEDURE ACTUALOVERLAYADDRESS(TYPE, MIX, LOC); 14105000
VALUE TYPE, MIX, LOC; 14106000
INTEGER TYPE, MIX, LOC; 14107000
BEGIN INTEGER T = +1; 14108000
$ SET OMIT = NOT(AUXMEM) 14108999
IF TYPE THEN % CODE... 14110000
BEGIN 14110100
$ SET OMIT = NOT(AUXMEM) 14110999
LOC := LOC INX 0; 14112000
T := JAR[MIX,LOC DIV (T:=JAR[MIX,8])+10]+LOC MOD T; 14113000
END ELSE % BETTER BE DATA... 14114000
$ SET OMIT = NOT(AUXMEM) 14114999
T~DALOC[MIX,LOC.[33:6]+P(DUP)-1]+LOC.[39:9] 14117000
$ SET OMIT = NOT(AUXMEM) 14117999
END; 14119000
$ SET OMIT = NOT(AUXMEM) 14119999
COMMENT THE SEGMENT DICTIONARY IS CONSTRUCTED BY THE% 14125000
COMPILERS AND EACH ENTRY HAS THE FORMAT:% 14126000
[ 1: 1] = 1 FOR TYPE 2 SEGMENTS, =0 OTHERWISE,% 14127000
[ 2: 1] = 1 FOR INTRINSICS , = 0 OTHERWISE.% 14128000
[ 3: 1] = 1 IF BEING MADE PRESENT, = 0 OTHERWISE 14128100
(INTERLOCK FOR RE-ENTRANT CODE) 14128200
[ 4: 2] = 0 FOR NORMAL SEGMENTS 14128300
= 3 FOR SEGMENTS OVERLAID TO AUX. MEM. 14128400
= 2 FOR SEGMENTS TO BE OVERLAID TO 14128500
AUXILIARY MEMORY WHICH HAVEN"T BEEN 14128600
[ 6: 1] = 1 FOR COBOL68 FILE TANK, 14128700
[ 7: 1] = 1 FOR COBOL68 READ ONLY ARRAY. 14128800
[ 8:10] = LINK TO PRT FOR 1ST DESCRIPTOR FOR% 14129000
THIS SEGMENT.% 14130000
[16:15] = SEGMENT SIZE(<1024) FOR ABSENT 14131000
SEGMENTS.% 14132000
= CORE ADDRESS OF PRESENT SEGMENTS.% 14133000
= 1 FOR NEVER-PRESENT INTRINSICS.% 14134000
[33:15] = DISK ADDRESS OF SEGMENT.% 14135000
= INTRINSIC-NUMBER FOR INTRINSICS.% 14136000
THE PRT FOR PROGRAM SEGMENTS IS CONSTRUCTED BY THE% 14137000
COMPILERS IN THE FORMAT :% 14138000
[ 0:5] = PROGRAM DESCRIPTOR BITS.% 14139000
[ 6:1] = STOPPER BIT WHICH DEFINES THE [ 7:11]% 14140000
FIELD.% 14141000
[ 7:11] = LINK TO NEXT DESCRIPTOR THAT BELONGS TO% 14142000
THIS SEGMENT, IF STOPPER BIT FALSE.% 14143000
= SEGMENT NUMBBER, IF STOPPER TRUE.% 14144000
[18:15] = F-REGISTER FIELD USED AT RUN TIME IN% 14145000
LABEL AND ACCIDENTAL DESCRIPTORS.% 14146000
= SEGMENT NUMBER FOR WORD MODE AND% 14147000
CHARACTER MODE DESCRIPTORS.% 14148000
[33:15] = CORE ADDRESS FOR PRESENT SEGMENTS.% 14149000
= RELATIVE ADDRESS FOR ABSENT SEGMENTS.% 14150000
I.E. RELATIVE TO BEGINNING OF SEGMENT.% 14151000
EACH PRT (R+4) CONTAINS A DESCRIPTOR WHICH POINTS 14152000
TO THE SEGMENT DICTIONARY.% 14153000
;% 14154000
PROCEDURE MAKEPRESENT(C); VALUE C; REAL C;% 14155000
BEGIN% 14156000
REAL SAVEBIT, MINE;% 14157000
REAL D,MOTHER,MOM,LOC,SIZE;% 14158000
INTEGER DISKADDR = SAVEBIT;% 14159000
DEFINE LINK= [ 7:11]#,STOPPER=[ 6: 1]#,PROGRAMDESC=[5:1]#;% 14160000
DEFINE NOTOPEN =[25:1] #;% 14161000
ARRAY NAME DD ;% 14162000
ARRAY AIT[*]; 14162500
ARRAY PRTR[*] ;% 14163000
REAL SEGNO=MOTHER, X=MOM,IOD ;% 14164000
REAL SPACE;% SPACE FOR SEGMENT NUMBERS (INTRINSICS) BY MIX 14164100
REAL MES,SAGE,GM; % SPACE FOR NO MEM MESSAGE. 14164200
REAL I,J; %101-14164300
$ SET OMIT = NOT(NEWLOGGING) 14164399
LABEL EXIT; % ALL AVENUES MUST LEAD TO HERE 14164500
LABEL WRAP,AROUND,TESTREADY;% 14165000
LABEL OPEN,CLOSE;% 14166000
LABEL CODEIN,INT; 14166100
LABEL DLOOP, NG; 14166200
DEFINE REVERSE =[22:1]#,READY =[19:1]#,PRESENT =[2:1]#;% 14167000
COMMENT MAKEPRESENT HAS THE FOLLOWING ACTIONS,DEPENDING ON THE TYPE% 14168000
OF DESCRIPTOR CAUSING PRESENCE BIT :% 14169000
DATA DESCRIPTOR :% 14170000
IF MOTHER ABSENT THEN GET CORE SPACE AND SET% 14171000
MOTHER PRESENT WITH PROPER CORE ADDRESS% 14172000
THEN IF INITIAL ACCESS,ZERO THE SPACE ELSE% 14173000
READ IN FROM DISK AND RETURN DISK SPACE% 14174000
THEN SET 1ST MEMORY LINK TO SAVE OR NOT SAVE% 14175000
AND SET 2ND LINK TO ADDRESS OF MOTHER% 14176000
IN ANY EVENT, SET COPY PRESENT WITH CORRECT CORE% 14177000
ADDRESS.% 14178000
IO DESCRIPTOR:% 14179000
PROGRAM DESCRIPTOR:% 14180000
;% 14181000
SUBROUTINE RUNAROUND;% 14182000
BEGIN WHILE NOT (PRTR[X] ~ ((LOC+2) INX PRTR[X])% 14183000
OR MEMORY).STOPPER DO X ~ PRTR[X].LINK;% 14184000
END RUNAROUND;% 14185000
% 14185100
$ SET OMIT = NOT(NEWLOGGING) 14185199
IF (D ~ M[C]).[1:1] THEN% 14186000
IF D.[6:2]=1 THEN % TYPE 13 INTRINSIC 14186010
BEGIN X:=[INTRINSC[SEGNO~MINE~NFLAG(D) INX 0]]; 14186020
SEGNO:=SEGNO-1; 14186030
STREAM(T:=SEGNO AND 3, I:=[INTABLE[P1MIX,SEGNO DIV 4]]); 14186100
BEGIN DI:=DI+T;DI:=DI+T;SKIP 1 DB;DS:=SET;END;%MARK TYPE 13 BIT14186110
IF X>0 THEN SLEEP([X],-0); 14186120
$ SET OMIT = NOT MONITOR 14186121
IF (X INX 0){1023 THEN 14186130
BEGIN P(ABS(X),[X],~); SIZE~X INX 0; 14186140
$ SET OMIT = NOT(AUXMEM) 14186143
DISKADDR := X.[6:27]; 14186148
MINE~MINE&SIZE[8:38:10]&3[1:46:2]; 14186150
IOD:=13; GO TO CODEIN; 14186152
END ELSE BEGIN M[C].[CF]~INTRNSC[MINE].[CF]; 14186160
M[C].[2:1]:=1; 14186170
GO EXIT; 14186180
END 14186190
END ELSE 14186200
BEGIN PRTR ~ PRT[P1MIX,*]; LOC ~ NFLAG(D)&0[5:5:1]; 14187000
DO IF LOC.PROGRAMDESC THEN SEGNO ~ LOC.[18:15]% 14188000
ELSE IF LOC.STOPPER THEN SEGNO ~ LOC.LINK% 14189000
ELSE LOC ~ NFLAG(PRTR[LOC.LINK])% 14190000
UNTIL SEGNO!0;% 14191000
DD ~ SEGNO INX PRTR[4];% 14192000
IF DD[0].[3:1] AND NOTERMSET(P1MIX) THEN 14193000
COMPLEXSLEEP((TERMSET(P1MIX) OR NOT DD[0].[3:1])); 14193100
IF TERMSET(P1MIX) THEN GO INITIATE; 14193200
IF (SIZE ~ (MINE ~ DD[0]).[18:15]){1023 THEN% 14194000
BEGIN DD[0].[3:1] ~ `;% 14195000
IF MINE<0 THEN% 14196000
IF PRTR[X ~ MINE.[8:10]].[2:1] THEN GO AROUND;% 14197000
IF MINE.[2:1] THEN% 14198000
BEGIN X ~ [INTRNSC[MINE INX 0]];% 14198100
IF X>0 THEN SLEEP([X],-0);% 14198200
IF (X INX 0){1023 THEN BEGIN P(ABS(X),[X],~);% 14198300
SIZE ~ X INX 0; 14198400
$ SET OMIT = NOT MONITOR 14198410
$ SET OMIT = NOT(AUXMEM) 14198499
DISKADDR ~ X.[6:27]; 14198700
END ELSE BEGIN LOC ~ (SIZE ~ X INX 0)-2; 14198800
DD[0].[FF] ~ SIZE; GO AROUND;% 14199000
END;% 14200000
END ELSE IF JAR[P1MIX,10]=0 THEN% 14201000
DISKADDR := DATADDRESS(P1MIX, MINE) 14202000
ELSE DISKADDR := CODEADDRESS(P1MIX, MINE); 14203000
IOD:=6|MINE.[2:1]+(MINE LSS 0)+1; 14203010
CODEIN:: WHILE (LOC~GETSPACE(SIZE,IOD,(MINE<0 AND MINE.[6:1])+66)) 14203020
= 0 DO 14203021
BEGIN IF TERMSET(P1MIX) THEN 14203100
BEGIN IF MINE.[2:1] THEN 14203200
INTRNSC[MINE]:=NABS(*P(DUP)); 14203300
IF D.[6:2]=1 THEN 14203400
INTRNSC[D]:=NABS(*P(DUP)); 14203500
DD[0].[3:1]:=0; GO TO INITIATE; 14203600
END; 14203700
IF(SPACE:=SPACE+1)=5 THEN 14204000
BEGIN STREAM(P1MIX,SIZE,T:=[MES]); 14204100
BEGIN SI:=LOC P1MIX; DS:=2 DEC; 14204200
DS:=8LIT" NO MEM ";DS:=5 DEC; 14204300
DS:=5 LIT " WDS~"; 14204400
END; 14204500
P(WAITIO([MES],@177,25),DEL); 14204600
END; 14204700
SLEEP([CLOCK],NOT CLOCK); 14205000
END; 14205100
IF MES NEQ 0 THEN 14205200
BEGIN STREAM(T:=[MES]); 14205300
BEGIN DI:=DI+3;DS:=7LIT"OK MEM~" END; 14205400
P(WAITIO([MES],@177,25),DEL); 14205500
END; 14205600
DISKIO(IOD, -LOC-1, SIZE, DISKADDR); X ~ MINE.[8:10];% 14206000
SLEEP([IOD],IOMASK); 14206100
IF IOD.[26:7] NEQ 0 THEN 14206110
BEGIN 14206120
IF MINE.[2:1] THEN INTRNSC[MINE]:=NABS(*P(DUP)); 14206135
DD[0].[3:1] := 0; 14206140
GO TO NG; 14206145
END; 14206160
$ SET OMIT = NOT(STATISTICS) 14206299
IF D.[6:2]=1 THEN 14206310
BEGIN M[C].[CF]~LOC+2; 14206320
M[C].[2:1]~1; 14206330
GO TO INT; 14206340
END; 14206350
IF MINE>0 THEN BEGIN RUNAROUND;% 14207000
M[C] ~ ((LOC+2) INX D) OR MEMORY;% 14208000
INT: 14208010
IF MINE.[2:1] THEN% 14209100
BEGIN M[LOC] ~ (*P(DUP))&0[9:9:6];% 14209200
INTRNSC[MINE INX 0] ~ -(*P(DUP))&(LOC+2)[CTC];% 14209300
END ELSE% 14209500
IF (X ~ PRTR[4].[18:6])!0 THEN% 14210000
M[LOC] ~ (*P(DUP))&X[9:42:6];% 14211000
IF DISKADDR>0 THEN M[LOC+1] := 0 & SIZE[CTF]; 14212000
M[LOC+1] := (*P(DUP)) & SEGNO[CTC]; 14212010
IF MINE.[2:1] THEN M[LOC+1] ~ (*P(DUP))&MINE[8:38:10];% 14212100
IF D.[6:2]=1 THEN 14212200
BEGIN M[LOC].[2:1]~0; GO EXIT; 14212300
END; 14212400
DD[0].[18:15] ~ LOC+2;% 14213000
END PROGRAM CODE SEGMENTS% 14214000
ELSE BEGIN 14215000
M[C] ~ PRTR[X] ~ M OR ((LOC+2)% 14216000
&(M[LOC+1] ~ [PRTR[X]] INX 0)[18:33:15]% 14217000
& (MINE.[7:1]|24) [3:43:5] % COBOL68 READ ONLY 14217500
&SIZE[8:38:10]);% 14218000
IF MINE.[6:1] THEN % COBOL68 FILE TANK 14218010
IF NOT P(M[LOC+4],TOP,XCH,DEL) THEN% BUILD FIB PTR14218025
BEGIN 14218027
P([M[LOC+4]],DUP,DUP,LOD,XCH,INX,M[C],FFX, 14218030
@100026,DIA 32,DIB 2 TRB 16,XCH,~); 14218035
WHILE (AIT~PRTR[AITNDX]).PBIT=0 14218040
DO MAKEPRESENT([PRTR[AITNDX]] INX 0); 14218045
IF AIT.[8:10] < AIT[0]+2 THEN 14218050
BEGIN P(AIT,0,0); INTERRUPT(1);% PHONEY INVALID14218055
P(DEL,DEL,DEL); % INDEX ON AIT 14218060
AIT ~ PRTR[AITNDX]; 14218065
END; 14218070
IF AIT[AIT[0]].[8:10] NEQ 1 THEN %101-14218072
BEGIN %101-14218074
I := 1; %101-14218076
WHILE AIT[I].[8:10] = 1 DO I := I + 1;%101-14218078
FOR J := AIT[0] STEP -1 UNTIL I DO %101-14218080
AIT[J+1] := AIT[J]; %101-14218082
END ELSE I := AIT[0] + 1; %101-14218084
AIT[0] := *P(DUP) + 1; %101-14218086
AIT[I] := -(1 & 1[8:38:10] & M[C][FTF]); %101-14218088
END; 14218090
$ SET OMIT = NOT(STATISTICS) 14218099
END TYUPE TWO DATA SEGMENTS;% 14219000
IF NOT MINE.[6:1] THEN M[LOC].[2:1] ~ 0; 14220000
END ABSENT SEGMENTS% 14221000
ELSE BEGIN LOC ~ SIZE-2;% 14222000
AROUND: IF DD[0]>0 THEN% 14223000
IF NOT PRTR[X ~ DD[0].[8:10]].[2:1] THEN RUNAROUND;% 14224000
M[C] ~ IF DD[0]>0 THEN ((SIZE INX D) OR M)% 14225000
ELSE PRTR[DD[0].[8:10]];% 14226000
END;% 14227000
IF DD[0].[2:1] THEN% 14227100
BEGIN % INTRINSIC 14227200
IF (SIZE:=(DD[0] INX 0)-1) NEQ 16 THEN %NOT INTRINSIC 17 14227210
BEGIN 14227220
STREAM(SEGNO, T ~ SIZE AND 3,% 14227300
I ~ [INTABLE[P1MIX,SIZE DIV 4]]);% 14227400
BEGIN 14227500
SI:=I; SI:=SI+T; SI:=SI+T; SKIP 1 SB; 14227520
IF SB THEN; % REMEMBER TYPE 13 REFERENCE 14227540
DI:=DI+T; DI:=TI+T; T:=DI; SI:=LOC T; 14227560
SI:=SI-2; DS:=2 CHR; 14227580
IF TOGGLE THEN BEGIN DI:=T; SKIP 1 DB; DS:=SET; END; 14227600
END; 14227620
END; 14227630
END;% 14227700
DD[0].[3:1] ~ 0; GO EXIT; 14228000
END;% 14229000
IF (MOM:=D.[3:5])!0 AND (MOM AND @33)!@30 THEN 14230000
BEGIN% 14231000
COMMENT I/O DESCRIPTOR;% 14232000
IF JAR[P1MIX,2] < 0 THEN 14233000
BEGIN TERMINATE(P1MIX); 14233100
TERMINALMESSAGE(25); 14233200
END; 14233300
MOM~ MEMORY[D INX (IF D.REVERSE THEN 2 ELSE NOT 1)]% 14234000
INX 0;% 14235000
TESTREADY: IF NOT MEMORY[MOM].READY THEN% 14236000
SLEEP([MEMORY[MOM]],IOMASK);% 14237000
IF MEMORY[MOM].PRESENT THEN% 14238000
MEMORY[C]~MEMORY[MOM]% 14239000
ELSE% 14240000
BEGIN% 14241000
IF MEMORY[MOM].NOTOPEN THEN% 14242000
OPEN: BEGIN SAVEOPEN(MOM); IF TERMSET(P1MIX) THEN GO EXIT; 14243000
GO TESTREADY END 14244000
ELSE BEGIN% 14245000
COMMENT READY AND NOT PRESENT INDICATES REEL-SWITCH OR TERMINATE;% 14246000
PRTR~M[MOM-3];% 14247000
LOC~PRTR[15].[25:5];% 14248000
SIZE~PRTR[4].[8:4];% 14249000
IF M[MOM].[27:1] THEN% 14250000
IF M[MOM].[24:1] THEN% 14251000
BEGIN IF SIZE=2 AND NOT PRTR[4].[2:1]% 14252000
AND NOT M[MOM].[22:1] THEN% 14253000
BEGIN BLASTQ(LOC);% 14254000
P(WAITIO(M[MOM-2],0,LOC),DEL);% 14255000
P(WAITIO(@1000000340000005,0,LOC),DEL);% 14256000
IF M[M[MOM-2] INX 4].[42:6]=1 THEN% 14257000
CLOSE: BEGIN LOC~PRTR[13].[28:10];% 14258000
FILECLOSE(MOM&@12[18:33:15]);% 14259000
PRTR[13].[28:10]~LOC+1;% 14260000
GO TO OPEN;% 14261000
END;% 14262000
END;% 14263000
END ELSE% 14264000
BEGIN IF SIZE=2 OR SIZE=7 OR SIZE=8 THEN% 14265000
BEGIN IF NOT PRTR[4].[2:1] THEN% 14266000
M[M[MOM-2] INX 4].[42:6]~1;% 14267000
GO TO CLOSE;% 14268000
END;% 14269000
END;% 14270000
P(MOM,M[MOM].[27:1]+1,0,0,);% 14271000
COM11;% 14272000
END;% 14273000
END;% 14274000
END% 14275000
ELSE% 14276000
BEGIN% 14277000
COMMENT DATA DESCRIPTOR;% 14278000
DLOOP: 14278100
IF (MOTHER~MEMORY[MOM ~ D.[18:15]]).[2:1] THEN GO WRAP;% 14279000
IF (MOTHER INX 0) = 6 THEN % I/O ERROR FROM OLAY 14279150
BEGIN 14279200
TERMINATE(P1MIX & 20[CTF]); 14279250
GO TO INITIATE; 14279350
END; 14279400
IF (MOTHER INX 0) = 5 THEN % INTERLOCK FROM OLAY 14279450
BEGIN 14279500
COMPLEXSLEEP(((M[MOM] INX 0) NEQ 5)); 14279550
GO TO DLOOP; 14279600
END; 14279650
SAVEBIT ~ MOTHER.[CF]=1; 14280000
MEMORY[MOM] ~ MOTHER&((LOC ~GETSPACE(SIZED~MOTHER.[8:10],2,% 14281000
SAVEBIT+64))+2)[CTC]&1[2:47:1]; 14282000
$ SET OMIT = NOT(AUXMEM) 14282099
IF MOTHER.[CF]{3 THEN 14283000
STREAM(L~LOC+2, S~SIZE-1, T~0, W~(MOTHER.[CF]=2)); 14284000
BEGIN SI ~ LOC S;SI~SI+6;DI~LOC T;DI~DI+7;DS~CHR;% 14285000
DI~L; SI~LOC W; SI~WDS; 14286000
SI~L; T(DS~32 WDS; DS~32 WDS); DS~S WDS;% 14287000
END ZERO SPACE% 14288000
ELSE% 14289000
BEGIN% 14290000
COMMENT READ ARRAY FROM DISK AND RETURN DISK SPACE;% 14291000
$ SET OMIT = NOT(STATISTICS) 14291099
DISKIO(IOD,-LOC-1,MOTHER.[8:10],% 14292000
DATADDRESS(P1MIX, MOTHER)); 14292100
SLEEP([IOD],IOMASK); 14292110
IF IOD.[26:7] NEQ 0 THEN 14292120
BEGIN 14292130
NG: FORGETSPACE(LOC+2); 14292140
COMPLEXSLEEP(TERMSET(P1MIX)); 14292150
GO TO INITIATE; 14292160
END; 14292170
$ SET OMIT = NOT(STATISTICS) 14292199
MOM~MOM&MOTHER[CTF]; 14293000
END ;% 14295000
MEMORY[LOC].[2:1] ~ SAVEBIT;% 14296000
MEMORY[LOC+1] ~ MOM ;% 14297000
$ SET OMIT = NOT(STATISTICS) 14297099
WRAP:% 14298000
MEMORY[C] ~ IF D.[8:10] = 0 THEN P(M[MOM],0,CDC,D,XCH,INX)% 14299000
ELSE MEMORY[MOM];% 14300000
END;% 14301000
EXIT: 14301100
$ SET OMIT = NOT(NEWLOGGING) 14301199
END MAKEPRESENT ;% 14302000
REAL ADDRS=NT1;% 14342000
PROCEDURE ZIPPER(A,B,C);VALUE A,B,C; REAL A,B,C; FORWARD; 14342100
PROCEDURE COM5;% 14343000
BEGIN% 14344000
REAL RCW=+0,% 14345000
ERTOG=+2,% 14346000
I =+3,% 14347000
T =+4,% 14348000
INTEGER J=1;% 14349000
ARRAY VECTOR=+5[*],S=+6[*];% 14350000
INTEGER Q=S; 14350100
ARRAY FILEBLOCK=+7[*];% 14351000
ARRAY TSKA=+13[*]; 14351050
INTEGER LINK; LABEL RETURNEM; 14351100
INTEGER MOTHER=+8, NEXTMOM=+9, MOMMIX=+10, CATCH=+11;% 14351200
REAL ENDAIT=MOMMIX,A=MOMMIX,K=NEXTMOM; 14351205
REAL CHAIN=+12,ABSEVT=CHAIN; 14351210
REAL MSCW = -1; 14351220
REAL JAR9 = TSKA+1; %519-14351230
$ SET OMIT = NOT(WORKSET) 14351240
REAL STOPMIX=JAR9+1; LABEL STOPLOOP; 14351250
$ POP OMIT % WORKSET 14351260
SUBROUTINE DELINKIT; 14351300
BEGIN T:=M[I] INX 0; 14351310
IF NOT M[T].[4:1] THEN SLEEP([M[T]],@200000000000000); 14351320
M[T].[4:1]:=0; 14351330
IF M[I].[2:1] THEN%IN CONTROL 14351340
BEGIN M[T].[CF]:=M[I].[FF]; 14351350
IF (M[T] INX 0) NEQ 0 THEN M[M[T] INX 0].[2:1]:=1 14351360
ELSE M[T]:=ABS(M[T]);%UNLOCK IT 14351370
END ELSE% IN WAIT QUEUE 14351380
BEGIN T:=M[T] INX 0; 14351390
WHILE M[T].[FF] NEQ (I INX 0) DO 14351400
T:=M[T].[FF]; 14351410
M[T].[FF]:=M[I].[FF]; 14351420
END; 14351430
M[T].[4:1]:=1; 14351440
END; 14351450
PRYOR[P1MIX] ~ -1; 14351500
P((ADDRS:=GETSPACE(196,12,0))+1,STS,.COM5,RCW,0,RDS,0,XCH,CFX, 14353000
STF); 14353002
P(P&[MSCW][CTF],0,0,0,0,0,0); 14354000
P(0,0,0,0,0,0,0); % ZERO FILEBLOCK THRU JAR9... %172-14355000
$ SET OMIT = NOT(WORKSET) 14355020
P(0); % STOPMIX 14355030
$ POP OMIT % WORKSET 14355040
M[(FILEBLOCK~PRT[P1MIX,3]) INX 0-2].[9:6] ~ 0;% 14356000
M[ADDRS]~(*P(DUP))&0[9:9:6]; 14357000
M[(VECTOR~JARROW[P1MIX]) INX 0-2]~(*P(DUP))&0[9:9:6]; 14358000
IF VECTOR[0]<0 THEN% 14358100
BEGIN CATCH~PRT[P1MIX,@26]; 14358150
ERTOG ~ (VECTOR[1]>0) OR (PRT[P1MIX,@25]!0);% 14358200
END; 14358300
IF VECTOR[2].[6:1] THEN % IPC 14358310
BEGIN IF VECTOR[1]<0 THEN % DS-ED TASK 14358315
BEGIN WHILE (S~PRT[P1MIX,AITNDX]).PBIT=0 DO % SEARCH AIT FOR 14358320
MAKEPRESENT( PRTROW[P1MIX] INX AITNDX); % TASK ARRAYS 14358325
MEMORY[S INX NOT 1].[2:1] ~ 1; % MARK SAVE 14358330
ENDAIT ~ S[0]; 14358335
FOR K~1 STEP 1 UNTIL ENDAIT DO 14358340
BEGIN TSKA ~ MEMORY[(NT1~S[K]).MOM]; 14358345
IF NT1.[1:2]=3 THEN IF % DEPENDENT TASK 14358355
((NT2~TSKA[3])=1 OR (NT2=2 AND TSKA[4]!P1MIX)) THEN 14358360
% TASK ARRAY OF A SCHEDULED OR RUNNING OFFSPRING14358365
BEGIN IF NT2=1 THEN 14358370
BEGIN 14358373
SHEETDIDDLER(0,20,TSKA[4]); % ES14358375
END; 14358377
IF TSKA[3]=2 THEN % RUNNING 14358380
BEGIN 14358382
TERMINATE(TSKA[4]&86[CTF]); HALT; % DS14358383
NOPROCESSTOG ~ NOPROCESSTOG-1; 14358384
END; 14358385
COMPLEXSLEEP((TSKA[3] LSS 0)); 14358386
END; 14358389
END; 14358390
END; IF VECTOR[2].[5:1] THEN SOFTI ~ SOFTI-1; 14358391
IF (TSKA~PRT[P1MIX,TSX]).PBIT THEN 14358392
BEGIN IF TSKA[6]=1 THEN TSKA[7]:=1; 14358393
IF (I:=TSKA[5]) NEQ 0 THEN BEGIN I:=[PRT[P1MIX,I]] INX 0; 14358394
DELINKIT;WHILE(I:=M[I].[8:10]) NEQ 0 DO 14358395
BEGIN I:=[PRT[P1MIX,I]]INX 0;DELINKIT END END; 14358397
IF (I~TSKA[8].[CF])!0 THEN % SOFTWARE INTERRUPTS DECLARED 14358398
BEGIN IF NOT TSKA[8].[4:1] THEN 14358400
SLEEP([TSKA[8]],@200000000000000); 14358450
TSKA[8].[4:1] ~ 0; 14358460
DO % DETACH SOFTWARE INTERRUPTS 14358550
BEGIN IF (ABSEVT~PRT[P1MIX,I].[FF])!0 THEN 14358580
BEGIN WHILE NOT M[ABSEVT].[5:1] DO 14358582
ABSEVT ~ M[ABSEVT].[FF]; 14358584
IF M[ABSEVT]}0 THEN 14358586
SLEEP([M[ABSEVT]],@2000000000000000);14358588
M[ABSEVT] ~ P(LOD,DUP,SSP); 14358590
T ~ (K~PRT[P1MIX,I]).[FF]; 14358595
A ~ [PRT[P1MIX,I]] INX 0; 14358597
WHILE M[T].[FF]!A DO T ~ M[T].[FF]; 14358598
M[T].[FF] ~ K.[FF]; 14358600
M[ABSEVT] ~ P(DUP,LOD,SSN); 14358605
END; 14358610
I ~ PRT[P1MIX,I].[CF]; 14358615
END UNTIL I=0; 14358620
TSKA[8].[4:1] ~ 1; 14358625
END; 14358630
TSKA[3]:=-1; 14358640
END; 14358650
END; 14358700
JAR9 := VECTOR[9]; 14358710
CHAIN ~ 0&VECTOR[9][FTC]&VECTOR[1][1:1:1]; VECTOR[9].[FF] ~ 0; 14358800
$ SET OMIT = NOT(BREAKOUT) 14358999
IF VECTOR[2]<0 THEN % COBOL 14360100
IF VECTOR[1]>0 THEN % NOT DS-ED 14360200
WHILE PRT[P1MIX,16]>0 DO ASR;%CLEAN OUT AIT 14360300
IF VECTOR[1]>0 THEN % NOT DS-ED 14360310
FOR MOMMIX:=6 STEP 5 UNTIL 11 DO 14360320
BEGIN Q:=NFLAG(PRT[P1MIX,MOMMIX]); % AIT OR OAT ENTRY 14360330
IF Q.[2:1] THEN % PRESENT, GRAB ADDRESS FROM LINK 14360340
Q := Q & M[Q INX NOT 0];[FTC]; 14360350
IF Q.[33:3]=7 THEN % AUXILIARY MEMORY IN THE ACT 14360360
DISKRTN(Q.[CF], Q.[8:10]); 14360370
IF VECTOR[2]<0 THEN MOMMIX:=11; % COBOL HAS NOT OAT 14360380
END; 14360390
SLEEP([OLAYMASK],MOMMIX~TWO(P1MIX)); 14360400
OLAYMASK ~ NOT MOMMIX AND OLAYMASK; 14360500
MOTHER ~ DALOC[P1MIX,0].[CF]; 14360600
NEXTMOM := -1; S := DALOCROW[P1MIX]; 14360700
WHILE (NEXTMOM := NEXTMOM+2)<MOTHER DO 14360800
FORGETUSERDISK(S[NEXTMOM],-500); 14360900
SLEEP([TOGLE],STOREMASK); 14361000
MOTHER ~ (MOMMIX ~ (NEXTMOM ~% 14361100
PRT[P1MIX,4].[18:12]).[36:6])=P1MIX;% 14361200
NEXTMOM ~ NEXTMOM AND @77;% 14361300
$ SET OMIT = NOT(AUXMEM) 14361309
$ SET OMIT = NOT(DEBUGGING AND AUXMEM) 14361512
WHILE(T~M[I]).[CF] ! 0 DO% 14362000
BEGIN% 14363000
IF T > 0 THEN % IN USE AREA %167-14364100
IF T.AREAMIXF = P1MIX THEN % IN USE BY THIS MIX 14364200
IF MOTHER AND (P(T.AREATYPEF,DUP) = CODEAREAV 14364300
OR P(XCH) = SEGDICTAREAV) THEN % GIVE CODE 14364400
M[I].AREAMIXF := NEXTMOM % TO NEW MOM %167-14364500
ELSE %167-14364600
FORGETSPACE(I INX 2); %167-14364700
I := T.AREAFWDLINKF; %167-14364800
END;% 14367000
INTABLEROW[P1MIX] ~ 0;% 14367100
$ SET OMIT = NOT(BREAKOUT) 14367199
$ SET OMIT = NOT(BREAKOUT) 14367999
IF NEXTMOM!0 THEN BEGIN% 14370010
IF MOTHER THEN% 14370020
IF PRT[NEXTMOM,4].[24:6]=@77 THEN% 14370030
NFO[(NEXTMOM-1)|NDX+1] ~% 14370035
PRT[NEXTMOM,4] ~ (*P(DUP))&0[18:18:15]% 14370040
ELSE BEGIN MOTHER ~ NEXTMOM;% 14370050
DO UNTIL (MOTHER ~ (PRT[MOTHER,4] ~% 14370060
NFO[(MOTHER-1)|NXD+1] ~% 14370065
(*P(DUP))&NEXTMOM[18:42:6]).[24:6])=@77;% 14370070
END% 14370080
ELSE BEGIN% 14370090
IF (PRT[MOMMIX,4].[24:6]=P1MIX) AND% 14370100
NEXTMOM=@77 THEN NFO[(MOMMIX-1)|NDX+1] ~% 14370110
PRT[MOMMIX,4] ~ (*P(DUP))&0[18:18:15]% 14370115
ELSE BEGIN% 14370120
DO BEGIN MOTHER ~ MOMMIX; 14370130
MOMMIX ~ PRT[MOMMIX,4].[24:6];% 14370140
END UNTIL MOMMIX=P1MIX;% 14370150
NFO[(MOTHER-1)|NDX+1] ~% 14370155
PRT[MOTHER,4] ~% 14370160
(*P(DUP))&NEXTMOM[24:42:6];% 14370165
END END;% 14370170
NFO[(P1MIX-1)|NDX+1] ~% 14370180
PRT[P1MIX,4] ~ (*P(DUP))&0[18:18:15];% 14370190
END;% 14370200
$ SET OMIT = NOT(AUXMEM) 14370299
IF VECTOR[2].[8:10]! 0 THEN% 14371000
$ SET OMIT = STATISTICS 14371999
FORGETSPACE(DIRECTORYSEARCH(ABS(VECTOR[0]),IF VECTOR[0]<0 14372000
THEN "DISK " ELSE ABS(VECTOR[1]),13)); 14373000
$ POP OMIT 14373001
$ SET OMIT = NOT(STATISTICS) 14373099
IF VECTOR[2].[8:10] = 1 THEN % COMPILER ON COMPILE AND GO 14374000
BEGIN% 14375000
IF ERTOG=0 THEN% 14376000
BEGIN% 14377000
COMPLEXSLEEP((SCHEDULEIDS!NOT 0) AND 14378000
SHEETFREE); 14378100
LOCKTOG(SHEETMASK); 14379000
S~[M[GETSPACE(31,2,0)+2]]&30[8:38:10];14380000
DISKIO(T,-(S INX 0-1),30, 14381000
VECTOR[2].[FF]); 14382000
SLEEP([T],IOMASK); 14383000
STREAM(A~0:B~P(.SCHEDULEIDS)); 14383100
BEGIN SI~B; 14383200
47(SKIP SB; SKIP DB; TALLY~TALLY+1;14383300
IF SB THEN BEGIN END % -14383400
ELSE JUMP OUT); 14383450
DS~SET; A~TALLY; 14383500
END STREAM; 14383600
T ~ P; S[3] ~ D&T[8:38:10]; 14383700
S[25] ~ CATCH; 14383740
S[23].[24:24]~(CLOCK+P(RTR))DIV 60; 14383750
DISKIO(T,+(S INX 0-1),30, 14383800
VECTOR[2].[FF]); 14383900
SLEEP([T],IOMASK); 14384000
I ~ IF S[18] > MIXMAX THEN MIXMAX 14385000
ELSE S[18]; 14386000
IF SHEET[I].[CF] ! 0 THEN 14387000
BEGIN DISKIO(T,-(S INX 0-1),30, 14388000
SHEET[I].[FF]); 14389000
SLEEP([T],IOMASK); 14390000
S[29] ~ VECTOR[2].[FF]; 14391000
DISKIO(T,+(S INX 0-1),30, 14392000
SHEET[I].[FF]); 14392500
SLEEP([T],IOMASK); 14393000
END ELSE SHEET[I] ~ VECTOR[2].[FF]; 14394000
SHEET[I].[FF] ~ VECTOR[2].[FF]; 14395000
UNLOCKTOG(SHEETMASK); 14396000
FORGETSPACE(S INX 0);% %165-14396100
END% 14397000
ELSE BEGIN% 14398000
RETURNEM: 14398500
S~[M[GETSPACE(31,2,0)+2]]&30[8:38:10]; 14398600
DISKIO(T,-(S INX 0-1),30,VECTOR[2].[FF]); 14398700
SLEEP([T],IOMASK); 14398800
FORGETESPDISK(VECTOR[2].[18:15]);% 14399000
LINK ~ S[13]; 14399100
WHILE LINK!0 DO 14399200
BEGIN DISKIO(T,-(S INX 0-1),30,LINK); 14399300
SLEEP([T],IOMASK); 14399400
FORGETESPDISK(LINK); LINK ~ S[29]; 14399500
END; 14399600
FORGETSPACE(S); 14399700
END 14400000
END ELSE% 14401000
IF VECTOR[2].[8:10] = 0 THEN% 14402000
BEGIN% 14403000
VECTOR[9]:=VECTOR[9].[CF]; 14403900
FOR I~1 STEP 1 UNTIL VECTOR[9] DO% 14404000
IF VECTOR[9+I] ! 0 THEN% 14405000
FORGETUSERDISK[VECTOR[9+I],-VECTOR[8]); 14406000
IF VECTOR[2].[7:1] THEN VECTOR[2].[8:10]~2;%FOR TASK LOG 14406100
END ELSE 14407000
IF VECTOR[2].[8:10]=4% 14407100
THEN GO TO RETURNEM; 14407200
IF VECTOR[0]<0 THEN 14408000
IF ERTOG ! 0 THEN% 14409000
VECTOR[2].[8:10] ~ 3;% 14410000
I ~ P1MIX;% 14411000
COMMENT SUBTRACT CORE REQUIREMENTS FROM CORE WORD; 14411100
CORE.[18:15]~CORE.[18:15] - NFO[(P1MIX-1)|NDX+2].[18:15]; 14411200
$ SET OMIT = NOT(AUXMEM) 14411309
$ SET OMIT = NOT(DATACOM ) 14411499
IF CHAIN GTR 0 THEN 14411620
BEGIN S:=[M[SPACE(5)]]&5[8:38:10]; 14411640
DISKWAIT(-(S INX 0),5,CHAIN); 14411660
ZIPPER(S[1],S[2],S[3]); 14411680
FORGETSPACE(S); 14411700
END; 14411720
IF CHAIN ! 0 THEN FORGETESPDISK(ABS(CHAIN)); 14411740
IF VECTOR[2].[3:1] THEN 14411800
BEGIN 14411810
NT1:=TYPEDSPACE(5,MAINTBUFFAREAV);% %167-14411820
M[NT1-2].[9:6] := 0; 14411830
M[NT1 ]:= 0 & P1MIX[20:43:5]; 14411840
M[NT1+1]:= VECTOR[5].[1:23]; 14411850
M[NT1+2]:= XCLOCK & VECTOR[2][1:1:17] & 14411860
(VECTOR[1]<0)[18:42:6]; 14411870
M[NT1+3]:= VECTOR[0]; 14411880
M[NT1+4]:= VECTOR[1]; 14411890
LINKUP(14,NT1); 14411900
END; 14411910
$ SET OMIT = PACKETS 14411999
BEGIN; STREAM(TK~VECTOR[2].[7:1],B~IF VECTOR[1] <0 THEN 2 ELSE%110-14414000
VECTOR[2].[8:10]!3,I,Q~Q~((NT1~(XCLOCK DIV 3600)14415000
) MOD 60 + (NT1 DIV 60)|100), V:=VECTOR 14415100
$ SET OMIT = NOT PACKETS 14415150
,T:=T:=SPACE(10) 14415200
$ POP OMIT 14415250
); 14415300
BEGIN% 14416000
$ SET OMIT = PACKETS 14416999
$ SET OMIT = NOT(PACKETS) 14418099
SI:=V;SI:=SI+1;DS:=LIT" ";DS:=7CHR; 14418100
SI:=SI+1;DS:=LIT"/";DS:=7CHR; 14418110
$ POP OMIT 14418111
DS~LIT"="; SI~LOC I; DS~2DEC; 14419000
I~DI; DI~DI-2; DS~FILL; DI~I; 14419500
CI ~ CI+B;% 14420000
GO TO E;% 14421000
GO TO OK;% 14422000
DS~7 LIT " DS-ED "; 14423000
GO TO X;% 14424000
OK:% 14425000
DS~5 LIT " EOJ "; 14426000
TK(DI~DI-2; DS~2 LIT "T "); % END OF TASK %110-14426100
GO TO X;% 14427000
E: DS~11 LIT " SYNTX ERR "; 14428000
X: DS~ 4 DEC; DS~LIT "~"; 14429000
END; 14429100
$ SET OMIT = PACKETS 14429150
$ SET OMIT = NOT RJE OR OMIT 14430190
SPOUTER(T,0,(EOJMESS AND NOT(JAR9.[2:1]))); 14430400
END; 14430600
SIGNOFF(VECTOR,FILEBLOCK,0); 14430800
FORGETSPACE(VECTOR); 14431000
$ POP OMIT OMIT 14431010
$ SET OMIT = NOT(AUXMEM) 14431299
$ SET OMIT = NOT(WORKSET) 14431400
STOPLOOP: 14431410
IF WKSETSTOPJOBS NEQ 0 THEN % JOB WAS AUTO-STOPPED 14431420
IF NOT(JAR9.SYSJOBF) THEN % NOT EOJ FOR "SYSTEM" JOB 14431425
BEGIN 14431430
STNEXT:=IF STNEXT=0 THEN STQUEMAX ELSE STNEXT-1; %138-14431440
STOPMIX:=STQUE[STNEXT]; %138-14431450
STQUE[STNEXT]:=0; %138-14431460
STFIRST := (STFIRST+1).[44:4]; % POINT TO NEXT CELL 14431470
IF (STOPMIX GTR 0) AND (STOPMIX LEQ MIXMAX) THEN 14431480
IF JARROW[STOPMIX] NEQ 0 THEN 14431490
BEGIN 14431500
IF STOPSET(STOPMIX) THEN % NOT YET STOPPED 14431502
BEGIN 14431504
PRTROW[STOPMIX,X].[PSF]:=0; 14431506
WKSETSTOPJOBS:=WKSETSTOPJOBS AND 14431508
NOT (TWO(STOPMIX)); 14431510
JAR[STOPMIX,9].[3:1]:=0; 14431512
GO STOPLOOP; 14431514
END ELSE 14431516
BEGIN REPLY[STOPMIX]:=VOK; % WAKE IT UP 14431518
STREAM(J:=JARROW[STOPMIX],STOPMIX, 14431520
D:=Q:=SPACE(10)); 14431530
BEGIN 14431540
SI:=J; DS:=9LIT" AUTO-OK "; 14431550
2(SI:=SI+1; DS:=7CHR; DS:=LIT"/"); 14431560
DI:=DI-1; DS:=LIT"="; SI:=LOC STOPMIX; 14431570
DS:=2DEC; DS:=LIT"~"; DI:=DI-3; DS:=FILL; 14431580
END STREAM STATEMENT; 14431590
SPOUTER(Q,PSEUDOMIX[STOPMIX],1); %525-14431600
END; 14431602
END % IF AWAKENING A JOB 14431610
ELSE GO TO STOPLOOP 14431620
ELSE GO TO STOPLOOP; 14431630
END; % IF JOBS WHERE AUTO-STOPPED 14431640
WKSETSWITCHTIME := CLOCK + P(RTR); 14431650
$ POP OMIT % WORKSET 14431660
$ SET OMIT = NOT(WORKSET) 14431970
WKSETNOSELECT~(WKSETNOSELECT AND (WKSETSTOPJOBS ! 0)); 14431975
IF WKSETSTOPJOBS=0 THEN 14431980
$ POP OMIT % WORKSET 14431990
SELECTION;% 14432000
KILL([MSCW]); 14433000
END L5COM;% 14434000
PROCEDURE ZIPPER(W1,W2,USERSTA);VALUE W1,W2,USERSTA; 14531000
REAL W1,W2,USERSTA; 14531100
BEGIN REAL T,I; 14532000
T ~ GETSPACE(12,CONTROLCARDAREAV,0)+4;% %167-14533000
M[T-4].[9:6]~0;% 14534000
IF (I~USERCODE[P1MIX])=ABS(NOT 0) THEN I~ 0; 14534500
STREAM(K~@14,A~[W1],C~I,B~T); 14535000
BEGIN 14536000
SI~LOC K; SI~SI+7; DS~ CHR; 14537000
DS:= 5 LIT "USER="; SI:=LOC C; SI:=SI+1; DS:= 7 CHR; 14537100
DS~ 9 LIT ";EXECUTE "; SI~A; SI~SI+1; 14537200
DS~ 7 CHR; DS~ LIT "/"; SI~SI+1); DS~ 7 CHR; 14538000
DS~ 6 LIT ";END.~"; 37(DS~ LIT " "); 14539000
END; 14540000
IF USERSTA!0 THEN 14540100
BEGIN 14540200
I:=30; 14540300
IF USERSTA.[19:1] THEN ELSE T:=T&USERSTA[9:15:9]; 14540350
END 14540400
ELSE 14540500
I~IF P1MIX=0 OR USERCODE[P1MIX]=MCP THEN 31 ELSE 26; 14541000
$ SET OMIT = PACKETS 14541049
$ SET OMIT = NOT(PACKETS) 14541089
IF PSEUDOMIX[P1MIX] NEQ 0 THEN NYLONZIPPER[P1MIX].[2:1]:=0; 14541090
INDEPENDENTRUNNER(P(.CONTROLCARD),T&I[2:42:6] 14541100
&P1MIX[18:42:6]&PSEUDOMIX[P1MIX][24:39:9],192); 14541110
IF PSEUDOMIX[P1MIX] NEQ 0 THEN 14541120
SLEEP([NYLONZIPPER[P1MIX]],@1000000000000000); 14541130
$ POP OMIT 14541131
END ZIPPER;% 14542000
REAL PROCEDURE EUF(A,B,L); VALUE A,B,L; REAL A,B,L; 14543000
BEGIN% 14544000
REAL I,J,R,T,Z;% 14545000
REAL H; 14545100
ARRAY X[*];% 14546000
INTEGER S; 14546100
$ SET OMIT = SHAREDISK 14546199
DEFINE R1=R#, X1=X#; 14546200
$ POP OMIT 14546201
$ SET OMIT = NOT SHAREDISK 14546299
LABEL LL,FOUND,WHY,BYE; 14547000
LABEL CHECK,DOWN,BOMBOUT,DSD; 14548000
% 14548900
REAL SUBROUTINE THERE;% 14549000
% 14549100
% ON EXIT, X IS THE LAST BYPASS BLOCK READ AND J IS ITS ADDRESS. 14549110
% IF THERE IS TRUE, I IS THE INDEX OF THE ENTRY FOR THE FILE AND,14549120
% FOR SECURITYCHECK, H IS THE NEGATIVE OF ITS HEADER ADDRESS. 14549125
% IF THERE IS FALSE, T IS THE ADDRESS OF THE FIRST BLOCK WHICH 14549130
% HAS A VACANT SLOT. 14549140
% 14549150
BEGIN% 14550000
T:=0; 14550500
LL: FOR I:=0 STEP 3 UNTIL 57 DO 14551000
BEGIN IF (X[I] EQV A) = NOT 0 THEN 14551500
IF (X[I+1] EQV B) = NOT 0 THEN 14552000
BEGIN P(1); 14552500
H:=NABS(X[I+2]); 14552750
GO DOWN; 14553000
END; 14553500
IF (X[I] EQV @14) = NOT 0 THEN 14554000
IF T=0 THEN T:=J; 14554500
END; 14555000
IF (Z:=X[2].[FF])!0 THEN 14555500
BEGIN DISKWAIT(-R,60,J:=Z); 14556000
GO TO LL; 14556500
END; 14557000
IF T=0 THEN T:=J; 14557500
P(0); 14558000
DOWN: THERE:=P; 14558500
END;% 14559000
$ SET OMIT = NOT(SHAREDISK) 14559099
A:=ABS(A); 14559200
X:=[M[R:=SPACE(60)]]&60[8:38:10]; 14559250
IF (A OR B).[1:5]!0 OR A=@14 OR A=@114 THEN 14559300
BEGIN 14559400
TERMINATE(P1MIX&75[18:33:15]); GO DSD; 14559500
END; 14559600
$ SET OMIT = SHAREDISK 14559990
LOCKDIRECTORY; 14560000
$ POP OMIT 14560010
S:=SCRAMBLE(A,B); 14562000
CHECK: DISKWAIT(-R,-60,(J:=S)); 14563000
IF P1MIX !0 THEN 14564000
IF THERE THEN% 14567000
BEGIN 14568000
$ SET OMIT = NOT SHAREDISK 14568890
UNLOCKDIRECTORY; 14569000
$ POP OMIT OMIT 14569010
H~SECURITYCHECK(A,B,USERCODE[P1MIX],H)!7; 14569200
Z:=VWY&VOK[36:42:6]&(IF H THEN 0 ELSE VRM)[30:42:6]; 14569500
WHY: STREAM(A:=[A], B:=JAR[P1MIX], C:=P1MIX, UC:=H, 14570000
D:=J:=SPACE(10)); 14570100
BEGIN% 14571000
DS~13LIT"#DUP LIBRARY ";% 14572000
UC(DS~15LIT"(ILLEGAL USER) "); 14572100
SI~A ;SI~SI+1;DS~7CHR;% 14573000
DS~LIT"/" ;SI~SI+1;DS~7CHR;% 14574000
DS~LIT":";% 14575000
SI~B ;SI~SI+1;DS~7CHR;% 14576000
DS~LIT" " ;SI~SI+1;DS~7CHR;% 14577000
DS:=LIT"="; SI:=LOC C; DS:=2 DEC; DS:=LIT"~": 14578000
DI~DI-3; DS~FILL; 14578500
END;% 14579000
SPOUT(J); 14580000
REPLY[P1MIX]:=-Z; 14581000
IF AUTODS THEN %747-14581500
IF H=1 THEN TERMINATE(P1MIX&61[CTF]) ELSE REPLY[P1MIX]~VRM%747-14581700
ELSE %757-14581800
COMPLEXSLEEP(TERMSET(P1MIX) OR (REPLY[P1MIX] GTR 0)); 14582000
IF TERMSET(P1MIX) THEN 14583000
DSD: BEGIN FOR I:=M[L+10]+10 STEP -1 UNTIL 11 DO 14583100
IF M[L+I]!0 THEN FORGETUSERDISK(M[L+I],-M[L+9]); 14583200
GO TO BOMBOUT; 14583300
END; 14583400
IF NOT WHYSLEEP(Z) THEN GO TO WHY; 14584000
IF REPLY[P1MIX].[18:30]=VRM THEN 14585000
$ SET OMIT = NOT(DATACOM ) 14585050
BEGIN 14585200
IF P(DIRECTORYSEARCH(-A,B,7),DUP)=2 14585300
THEN BEGIN P(DEL); % ALWAYS TO SPO %589-14585350
LBMESS( A, B, -7, 25, 0, 0, 1 ); END %589-14585360
ELSE IF P=3 THEN GO DSD; 14585400
$ SET OMIT = NOT DATACOM 14585490
END; 14587200
REPLY[P1MIX]:=0; 14588000
$ SET OMIT = SHAREDISK 14588090
LOCKDIRECTORY; 14588100
$ POP OMIT 14588110
GO TO CHECK;% 14589000
END ELSE ELSE T:=S; % SETS UP FOR P1MIX=0 14590000
% 14590900
% THE FILE IS NOT THERE. WE SEARCH FOR A VACANCY. IF ONE IS FOUND14590910
% Z AND T ARE ITS ADDRESS. IF THERE ISNT ONE, Z IS THE ADDRESS OF14590920
% THE LAST BLOCK AND T IS SET TO THE ADDRESS OF THE NEW BLOCK. 14590930
% 14590940
$ SET OMIT = NOT SHAREDISK 14590990
DO BEGIN 14591500
IF (Z:=T)!J THEN DISKWAIT(-R,60,Z); 14592000
FOR I~0 STEP 3 UNTIL 57 DO 14593000
IF (X[I] EQV @14)= NOT 0 THEN GO TO FOUND; 14594000
END UNTIL (T:=X[2].[FF])=0; 14595000
X[2].[FF]~ BYPASS ~ BYPASS-2; 14596000
IF BYPASS.[CF] LEQ BYPASS.[FF] THEN GO TO BYE; 14598000
$ SET OMIT = SHAREDISK 14598090
DISKWAIT(R,60,Z); % WRITE OUT POINTER TO NEW BLOCK 14598100
$ POP OMIT 14598110
T:=BYPASS.[CF]; 14598200
X1[0]:=@14; MOVE(59,X1,X1 INX 1); 14598300
$ SET OMIT = NOT SHAREDISK 14598390
T:=0; 14598500
FOUND:% 14599000
PBCOUNT~PBCOUNT+((((A EQV"PBD ")=NOT 0) OR 14599900
((A EQV"PUD ")=NOT 0)) AND (B.[CF]=1)); 14599910
X[I]~A; X[I+1]~B; X[I+2].[CF]~NEXTSLOT; 14600000
$ SET OMIT = NOT SHAREDISK 14600290
DISKWAIT(R1,60,T); 14600500
% 14600900
% UPDATE THE NAME SEGMENT, BUT DONT WRITE IT OUT UNTIL THE NEW 14600910
% HEADER IS WRITTEN. 14600920
% 14600930
J~(NEXTSLOT-DIRECTORYTOP-3)&0[44:44:4]+DIRECTORYTOP+19; 14601000
I:=((T:=NEXTSLOT)-J)|2+30; 14601500
DISKWAIT(-R1,-30,J); 14602000
NEXTSLOT:=X1[I+1]; 14602500
X1[I]:=A; X1[I+1]:=B; 14603000
IF NEXTSLOT=0 THEN % GOING TO USE EOF RECORD 14603100
IF I=0 THEN % WRITE NEW EOF RECORD BEFORE 14603110
BEGIN P(X1[28],X1[29]); % DESTROYING CURRENT ONE 14603200
X1[28]:=@114; 14603300
X1[29]:=0; 14603310
NEXTSLOT:=T+30; 14603320
BYPASS.[FF] ~ J+16; 14603330
DISKWAIT(R1,30,J+16); 14603400
P([X1[29]],~,[X1[28]],~); % RESTORE CLOBBERED NAME 14603600
IF J~16 GEQ BYPASS.[CF] THEN 14603700
BYE: BYBY("DIRECTORY FULL~",15); 14603750
END ELSE 14603800
BEGIN X1[I-2]:=@114; X1[I-2]:=0; NEXTSLOT:=T-1 END; 14604000
% 14604900
% NOW WE CAN WRITE EVERYTHING OUT, NOTE THAT IN ORDER TO MINIMIZE14604910
% THE DAMAGE CAUSED BY AN UNTIMELY HANG, THE MAIN AND (FOR 14604920
% SHAREDISK) THE BYPASS DIRECTORIES ARE CORRECT AT ALL TIMES. 14604930
% 14604940
$ SET OMIT = NOT SHAREDISK 14605490
DISKWAIT(L+1,-30,T); % FILE HEADER 14607000
$ SET OMIT = NOT SHAREDISK 14608490
DISKWAIT(R1,-30,J); % NAME SEGMENT 14609000
$ SET OMIT = NOT SHAREDISK 14609990
$ SET OMIT = SHAREDISK 14617990
UNLOCKDIRECTORY; 14618000
$ POP OMIT 14618010
EUF:=T; 14619000
BOMBOUT:% 14620000
FORGETSPACE(R); 14621000
END ENTERUSERFILE ;% 14622000
PROCEDURE COM11; COMMENT ALGOL I/O COMMUNICATE;% 14623000
BEGIN %740-14624000
REAL CODE=-4, TANK=-5, ROW=-6, FID=-7, MID=-8, %740-14624100
STA=-6, RESULT=-7, TIMEOUT=-7 ; %740-14624200
NAME PHYL=-5; % %740-14624300
ARRAY HEADER=-5[*], FINAL=-6[*]; % %740-14624400
REAL B, T, F, S; % %740-14624450
NAME A; % % SAME STACK LOCATIONS AS BEFORE %740-14624500
REAL INFO, LOC, USASI, I; % %740-14624550
ARRAY FPB[*], FIB[*] ; % %740-14624600
$ SET OMIT = NOT DATACOM%740-14624990
LABEL PARITY, EOF, EOT, RDATA, SELERR, MESSAGE,%740-14627200
DISKSPACE,OPEN, CLOSE, HEADC, GIN, NG, %740-14627300
SLEAP, GRABIT, READSOUGHT, READSOUGHT2, %740-14627400
BACK, SEEKDC, DCWRITER, WHILOOP, COBOLDCWR,FINDBUF,%740-14628000
PURGELOCK,SPACE, REFILL, HEADLABEL,IOREQ, DCBUFRLS, 14628100
ROTATE, ABN; % %740-14629000
%740-14630000
SWITCH FUNCTION ~ OPEN, PARITY, EOF, EOT, DISKSPACE, 14631000
SEEKDC, CLOSE, RDATA, SELERR, SPACE, %740-14632000
REFILL, READLABEL,IOREQ, ROTATE, READC, %740-14632100
READSOUGHT,DCBUFRLS,DCWRITER, FINDBUF, COBOLDCWR, 14632200
PURGELOCK ; % %740-14632900
%740-14633000
GO TO FUNCTION [CODE] ; % %740-14634000
%740-14635000
PARITY: INFO~"PARITY "; B~"ERROR~ "; % %740-14636000
GO TO MESSAGE; % %740-14636100
EOF: INFO~"END FO "; B~"FILE~ "; % %740-14637000
GO TO MESSAGE; % %740-14639000
EOT: INFO~"FILE TO"; B~"O SMALL"; I~"~ "; % %740-14640000
GO TO MESSAGE; %740-14641000
:: % AT PURGELOCK, GO TO RDATA SHOULD BE TO MESSAGE ON WORD BOUNDY14641999
RDATA: INFO~"DATA ER"; B~"ROR, FM"; T~"T=R,~ "; % %740-14642000
GO TO MESSAGE; % %740-14642100
SELERR: INFO~"INVALID"; B~" OPERAT"; T~"ION ON~"; % %740-14643000
% %740-14643100
MESSAGE: FPB~PRT[P1MIX,3]; FIB~M[P(.TANK,LOD).[33:15]-3]; %740-14644000
IF FIB[5].[1:1] THEN INFO ~ -" INV" OR M; % %740-14644400
STREAM ( X ~ INFO, B, T, % THESE 3 MUST BE THIS ORDER 14645000
Z ~ 0, Q ~ TANK!0, % %740-14645400
F ~ IF TANK=0 THEN 0 ELSE [FPB[FIB[4].[13:11]]], 14645600
D ~( CODE ~ GETSPACE(12,2,0) +2) ); % %740-14645800
BEGIN DS ~ LIT "-"; SI ~ LOC X; % %740-14646000
IF SC = 0 THEN % MESSAGES WITH NEW WORDING %740-14646200
BEGIN 3( SI~SI+1; % CHARS IN INFO, B & T IN STACK 14646400
7( IF SC!"~" THEN DS~CHR ELSE JUMP OUT 2 TO L) ); 14646600
L: DS~LIT " "; % %740-14646800
END ELSE % UNCHANGED MESSAGES %740-14647000
BEGIN SI~SI+5; DS~3 CHR; SI~LOC X; %740-14647200
IF SC!"8" THEN DS ~ 11 LIT % %740-14647400
"WRITE TU 0 " % %740-14647600
ELSE IF SC=@30 THEN DS ~ 10 LIT % "INV" %740-14648000
"ALID USER " % %740-14648200
ELSE IF SC=@20 THEN DS ~ 10 LIT % %740-14648400
" WRT/SEEK " % %740-14648600
END; % NEXT, OPTIONALLY ADD <FILE SPECIFIER> %740-14649000
Q( SI~F; X~DI; DI~LOC Z; % %740-14650000
IF 8 SC!DC THEN % MFID ! "0000000" %740-14650200
BEGIN SI~F; SI~SI+1; DI~X; % %740-14650400
DS~7 CHR; DS~LIT "/"; X~DI; % %740-14650600
END; % %740-14650800
DI~X; SI~SI+1; DS~7 CHR ); % %740-14651000
DS ~ 2 LIT ":~"; % %740-14654000
END OF STREAM; % %740-14655000
TERMINATE(P1MIX); TERMINALMESSAGE((-CODE));% 14658000
DISKSPACE:OPEN:CLOSE: GO TO INITIATE;% 14659000
$ SET OMIT = DATACOM 14660499
SEEKDC:READC:READSOURGHT:DCBUFRLS:DCWRITER:FINDBUF:COBOLDCWR: 14660500
GO INITIATE; 14660525
$ POP OMIT 14660526
$ SET OMIT = NOT(DATACOM) 14660999
GO INITIATE; :: 14670600
PURGELOCK: SAVEWORD ~ SAVEWORD OR TWO(ROW); % RDATA USED TO FOLLOW 14671000
GO TO RDATA; :: % SPACE NEEDS TO BE ON WORD BOUNDARY %740-14673000
SPACE: FIB~M[P(.TANK,LOD).[33:15]-3]; LOC~FIB[15].[25:5];% 14675000
BLASTQ(LOC);% 14676000
FPB~[MEMORY[5]]&3[23:46:2]&ROW[22:1:1];% 14677000
ROW~ABS(ROW);% 14678000
WHILE (ROW~ROW-1)}0 DO INFO~WAITIO(FPB,@40,LOC);% 14679000
GO TO INITIATE; :: 14680000
REFILL: FIB~M[(TANK~P(.TANK,LOD).[33:15])-3];% 14681000
CODE~FIB[13].[10:9]-1;% 14682000
LOC~FIB[19].[33:15]-FIB[16].[33:15];% 14683000
FPB~MEMORY[FIB[16] INX 0+ROW];% 14684000
INFO~FPB.[18:15];% 14685000
FOR I~1 STEP 1 UNTIL CODE DO% 14686000
BEGIN IOREQUEST(FLAG(FIB[19]&(INFO+LOC)[33:33:15]),% 14687000
FIB[16]&INFO[33:33:15],FPB);% 14688000
MEMORY[TANK]~MEMORY[TANK]&0[2:2:1]&0[19:19:1]% 14689000
&0[26:26:7]&INFO[33:33:15];% 14690000
STREAM(CODE,T~MEMORY[TANK],TANK);% 14691000
BEGIN SI~TANK; SI~SI+8; DS~CODE WDS;% 14692000
SI~LOC T; DS~WDS;% 14693000
END;% 14694000
INFO~MEMORY[INFO+ROW].[18:15];% 14695000
END;% 14696000
GO TO INITIATE; :: 14697000
READLABEL: FIB~M[(TANK~P(.TANK,LOD).[33:15])-3];% 14698000
LOC~FIB[15].[25:5];% 14699000
BLASTQ(LOC);% 14700000
P(WAITIO((FIB[5].[44:1]|(M[TANK-2].[8:10]-1) INX M[TANK-2]) 14701000
&M[TANK][21:21:4],@37700000,LOC),DEL); 14702000
STREAM(Y:=0:X:=0;X1:=0,X2:=0,Z:=M[TANK-2]); 14702025
BEGIN DI:=LOC X; DS:=24 LIT "VOL1HDR1HDR2EOF1EOF2EOV1"; 14702050
DI:=LOC X; 14702100
6(TALLY:=TALLY+1; 14702150
SI:=Z; 14702200
IF 4 SC=DC THEN 14702250
JUMP OUT TO A); 14702300
TALLY:=0; 14702350
A: 14702400
Y:=TALLY; 14702450
END; 14702500
IF (USASI:=P)>0 THEN 14702550
USASITAPE(M[TANK-2].[CF],USASI,3,LOC,FIB[5].[44:1]); 14702600
P(WAITIO([M[5]]&3[23:46:2]&(NOT FIB[5])[22:44:1], 14703000
@37700000,LOC),DEL); 14703100
GO TO INITIATE; :: 14704000
IOREQ: FPB~MEMORY[(IF (INFO~NFLAG(MEMORY[P(TANK,DUP,[M],INX,PRL)]))14705000
.[22:1] THEN 2 ELSE NOT 1) INX INFO];% 14706000
IOREQUEST(FINAL,INFO,FPB);% 14707000
MEMORY[TANK]~MEMORY[TANK]&0[26:26:7]&0[19:47:1];% 14708000
GO TO INITIATE;% 14709000
$ SET OMIT = NOT(DATACOM ) 14709099
:: 14709300
ROTATE: TANK~P(.TANK,LOD).[33:15];% 14710000
STREAM(T~M[TANK],N~ROW-1,D~TANK);% 14711000
BEGIN SI~D; SI~SI+8; DS~N WDS; SI~LOC T; DS~WDS END;% 14712000
IF M[TANK].[3:5]=16 THEN 14712100
IF M[TANK].[24:1] THEN 14712200
IF (I~P(M[TANK-3],14,COC))!0 THEN 14712300
BEGIN 14712350
PHYL ~ TANK INX M; 14712400
FOR LOC ~ ROW-1 STEP -1 UNTIL 0 DO 14712450
BEGIN 14712500
INFO ~ NFLAG(PHYL[LOC]); %[19:2]=0 THEN I/O IN-PROCESS 14712510
IF (B~M[INFO INX NOT(2+(INFO.[19:2]=0))])!0 THEN 14712550
BEGIN 14712600
$ SET OMIT = NOT(DATACOM ) 14712649
IF (I~I-1) { 0 THEN 14712750
LOC ~ -1; 14712800
END; 14712850
END; 14712900
END; 14712950
GO TO INITIATE;% 14713000
END COM11;% 14714000
$ SET OMIT = NOT(DATACOM ) 14715000
PROCEDURE DISPLAY(X); VALUE X; REAL X;% 14719000
BEGIN REAL T; 14720000
STREAM(X:J~JARROW[P1MIX],P1MIX,% 14721000
Y ~T~SPACE(25));% 14722000
BEGIN DS ~ LIT "#";% 14723000
2(DS ~ J; SI ~ SI+1; DS ~ 7 CHR; J ~ SI;% 14724000
L: SI ~ SI-1;% 14725000
IF SC = " " THEN% 14726000
BEGIN DI ~ DI-1; GO TO L END;% 14727000
DS ~ LIT "/";);% 14728000
DI ~ DI-1; DS ~ LIT "=";% 14729000
SI~LOC P1MIX; DS~2DEC; P1MIX~DI; DI~DI-2; 14730000
DS~FILL; DI~P1MIX; DS~2LIT": "; 14730500
SI ~ X;% 14731000
H: 4(40(IF SC="~" THEN JUMP OUT 2 TO HH; 14732000
DS~CHR)); HH: 14733000
J ~ DI; DI ~ DI+8; SI~J;% 14734000
S: SI ~ SI-1; IF SC = " " THEN GO TO S;% 14735000
SI ~ SI+1; J ~ SI; DI ~ J; DS ~ LIT "~";% 14736000
X~ DI; 14737000
END; 14738000
X~ (((X~P) INX 0) -T)|8+X.[30:31]-1; 14739000
SPOUT(P(X,T)); 14740000
END;% 14741000
PROCEDURE COM13 ;% 15060000
BEGIN% 15061000
% COBOL IO INTERFACE COMMUNICATE% 15062000
REAL CODE = -4, REEL = -6 ;% 15063000
NAME FLOC = -5 ;% 15064000
ARRAY FIB [*];% 15065000
REAL T, COB68; 15066000
LABEL L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12,L13,L14,L15,% 15067000
L15,L17;% 15068000
SWITCH TYPE ~ L0,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,% 15069000
L12,L13,L14,L15,L16,L17;% 15070000
DEFINE INOUT=FIB[13].[27:1]#,DIREC=FIB[13].[25:1]#,% 15071000
SORTFILE=FIB[14].[7:1]#,LABELSOMITTED=FIB[4].[2:1]#;% 15072000
COB68 ~ (FIB ~ *(FLOC)).[8:10] = 22; 15073000
GO TO TYPE[CODE];% 15074000
L0:% 15075000
DO UNTIL FALSE;% 15076000
L1:% 15077000
L2:% 15078000
L3:% 15079000
INOUT~CODE!3; DIREC~ CODE=2;% 15080000
IF NOT COB68 THEN 15080900
IF FIB[5].[46:2]=3 THEN BEGIN% 15081000
FIB[18].[18:15]~FIB[18].[3:15];% 15082000
IF CODE=3 THEN 15082100
FIB[18].[3:15]~FIB[18].[33:15]+FIB[18].[3:15]; END;% 15083000
NT1:=FLOC INX 3; 15084000
P(0,STF,PRT[P1MIX,8],STS); 15085000
FILEOPEN(1,NT1); 15086000
L16:% 15088000
L17:% 15089000
DO UNTIL FALSE;% 15090000
L5: L6:L7:L8:L9:L10:L11:L12:L13:L14:L15:% 15091000
DO UNTIL FALSE;% 15092000
L4:% 15093000
CODE ~ IF (CODE~ABS(REEL))=0 THEN 6 ELSE% 15094000
(IF CODE=1 THEN 7 ELSE% 15095000
(IF CODE=2 THEN 10 ELSE% 15096000
(IF CODE=4 THEN @22 ELSE %KRUNCH 15097000
(IF CODE=64 THEN @52 ELSE 0)))); %KRUNCH 15097500
IF (T~FIB[4].[8:4])!2 AND T!4 AND T!8 THEN CODE~0;% 15098000
IF T=4 AND CODE=0 THEN CODE~10 ;% 15099000
FILECLOSE(( FLOC INX 3 )& CODE[18:33:15]);% 15100000
IF CODE=0 OR CODE=10 OR CODE=@22 THEN FIB[5].[42:1]~1 15101000
ELSE FIB[5].[40:2]~(CODE=7)|2+1;% 15102000
IF NOT COB68 THEN 15102900
IF FIB[5].[46:2]=3 THEN BEGIN% 15103000
FIB[18].[3:15]~FIB[18].[18:15];FIB[18].[18:15]~0 END;% 15104000
GO TO INITIATE;% 15105000
END COM13;% 15106000
PROCEDURE REELCHANGER(U); 15110000
VALUE U; REAL U; 15110100
% 15110200
% THE PURPOSE OF THIS ROUTINE IS TO ALLOW REEL CHANGE FOR 15110300
% OUTPUT TAPE FILES BY OPERATOR REQUEST. THIS ROUTINE IS 15110400
% INITIATED FROM THE SPO WITH A KEYBOARD INPUT REQUEST OF 15110500
% "RC" FOLLOWED BY A THREE CHARACTER TAPE UNIT IDENTIFIER. 15110600
% 15110700
% IF THE WRITEPARITYREELSWITCH ROUTINE IS RUNNING 15110800
% CONCURRENTLY WHEN THE "RC" MESSAGE IS RECEIVED, 15110900
% THEN THIS ROUTINE WILL ABORT. OTHERWISE IT WILL 15111000
% CALL WRITEPARITYREELSWITCH IN ORDER TO AFFECT THE 15111100
% NECESSARY REEL CHANGE. 15111200
% 15111300
% THE PARAMETER IS USED AS FOLLOWS: 15111400
% U THE LOGICAL UNIT NUMBER OF THE TAPE UNIT TO SWITCH 15111500
% 15111600
BEGIN 15111700
REAL RCW=+0, MKSW=-2; 15111800
REAL MIX,TOPIOD,T2; 15111900
% 15112000
% THE LOCAL VARIABLES ARE USED AS FOLLOWS: 15112100
% REALS 15112200
% MIX MIX INDEX OF JOB USING TAPE UNIT U 15112300
% TOPIOD LOCATION OF TOP I/O DESCRIPTOR IN TANK 15112400
% T2 TEMPORARY 15112500
% 15112600
LABEL RESETJAR,ERROROUT,EXIT; 15112700
$ SET OMIT = NOT(PACKETS) 15112800
DEFINE UNITNO = PSEUDOMIX[MIX]#; 15112900
$ POP OMIT 15113000
MIX ~ RDCTABLE[U].[8:6]; 15113100
TOPIOD ~ PRNTABLE[U].[15:15]; 15113200
IF (MIX=0) OR (TOPIOD=0) OR TERMSET(MIX) THEN GO ERROROUT; 15113300
JAR[MIX,9] ~ (*P(DUP)) & 1[1:47:1]; 15113400
IF JAR[MIX,9].SYSJOBF = LIBMAINCODE THEN 15113500
BEGIN 15113700
STREAM(A~TINU[U], T~T2~SPACE(4)); 15113800
BEGIN 15113900
DS ~ 23 LIT"#REEL CHANGE MARKED ON "; 15114000
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR; DS ~ LIT"~"; 15114100
END; 15114200
SPOUTER(T2,UNITNO,1); 15114300
GO EXIT; 15114400
END; 15114500
IF NOTERMSET(MIX) THEN PRTROW[MIX].[PSF] ~ 2; 15114600
COMPLEXSLEEP(NOT(STOPSET(MIX)) AND UNIT[U].[FF]=@77777); 15114700
% IF UNIT NOT ASSIGNED AT THIS POINT THEN 15114800
% WRITEPARITYREELSWITCH HAS ALREADY BEEN RUN. 15114900
IF RDCTABLE[U].[8:6]=0 OR TERMSET(MIX) THEN GO RESETJAR; 15115000
T2~NFLAG(M[TOPIOD])&TINU[U][3:3:5]; 15115100
P(WRITEPARITYREELSWITCH(T2,1),DEL); 15115200
RESETJAR: 15115300
IF NOTERMSET(MIX) THEN JAR[MIX,9] ~ (*P(DUP)) & 0[1:47:1]; 15115400
GO EXIT; 15115500
ERROROUT: 15115600
STREAM(T~T2~SPACE(3)); 15115700
DS ~ 21 LIT"#REEL CHANGE ABORTED~"; 15115800
SPOUTER(T2,UNITNO,1); 15115900
EXIT: 15116000
KILL([MKSW]); 15116100
END REELCHANGER; 15116200
BOOLEAN PROCEDURE CONQUER(C,N,L,S,G); 15168000
VALUE C,N,L,S,G; 15168100
REAL C,N,L; ARRAY S[*]; 15169000
INTEGER G; 15169100
BEGIN ARRAY B=C[*];% 15170000
REAL T,I=T;% 15171000
LABEL X;% 15172000
IF G THEN 15172500
IF N|L > 512 THEN GO TO X;% 15173000
IF (T ~ GETSPACE(N|L,2,3)) = 0 THEN% 15174000
BEGIN IF NOT G THEN P(0,RTN); 15175000
X: IF NOT N THEN 15175900
BEGIN G~CONQUER(C,N~N DIV 2,L,N INX S,1); 15176000
G~CONQUER(S INX N,N,L,X,1); 15177000
P(1,RTN); 15177800
P(XIT);% 15178000
END;% 15179000
T ~ GETSPACE(L,2,1);% 15180000
END;% 15181000
B ~ [M[T+2]]&L[8:38:10]&C[18:33:15];% 15182000
N ~ N-1;% 15183000
FOR I ~ 0 STEP 1 UNTIL N DO% 15184000
BEGIN S[I] ~ B;% 15185000
B ~ L INX B;% 15186000
END;% 15187000
CONQUER~1; 15187500
END;% 15188000
BOOLEAN PROCEDURE PRTGAMES(BUFF,MIX); VALUE BUFF,MIX; REAL BUFF,MIX; 15400000
COMMENT PRTGAMES IS THE BUSINESS END OF "IN" OR "OT" MESSAGES; 15401000
BEGIN REAL NX,INDEX,DATA; 15402000
$ SET OMIT = NOT(PACKETS) 15402499
DEFINE UNITNO = PSEUDOMIX[MIX]#; 15402500
$ POP OMIT 15402501
LABEL ECH, X;;; 15403000
STREAM(BUFF,G~MIX=63,F~BUFF<0,D~[DATA],I~[INDEX]);% %844-15404000
BEGIN SI~BUFF; 15405000
L: IF SC=" " THEN BEGIN SI~SI+1; GO L END; 15406000
G(IF SC!" " THEN IF SC!"~" THEN IF SC!"=" THEN %844-15406100
BEGIN TALLY~TALLY+1; SI~SI+1 END); %844-15406200
4(IF SC!" " THEN IF SC!"~" THEN IF SC!"=" THEN 15407000
BEGIN TALLY~TALLY+1; SI~SI+1; END); 15408000
I~TALLY; DI~DI+8; DI~DI-I; SI~SI-I; DS~I CHR; 15409000
F( 15410000
M: IF SC=" " THEN BEGIN SI~SI+1; GO M END; 15411000
IF SC!"=" THEN BEGIN E:DI~DI-1;DS~LIT""";JUMP OUT END; 15412000
SI~SI+1; 15413000
N: IF SC=" " THEN BEGIN SI~SI+1; GO N END; TALLY~0; 15414000
8(IF SC}"0" THEN BEGIN TALLY~TALLY+1; SI~SI+1 END 15415000
ELSE JUMP OUT); IF SC!" " THEN IF SC!"~" THEN GO E; 15416000
I~TALLY; DI~D; SI~SI-1; DS~I OCT); 15417000
END; IF M[X!63 THEN BEGIN % NOT ABSOLUTE CORE ADDRESS %844-15418000
IF (INDEX AND NOT @1070707)!0 THEN GO ECH; %844-15418500
IF JARROW[MIX]=0 THEN GO ECH; 15419000
IF (NX~INDEX.[45:3]&INDEX[42:39:3]&INDEX[39:33:3]&INDEX[38:29:115420000
]){20 THEN GO ECH; 15421000
IF (PRTROW[MIX] INX NX)>M[PRT[MIX,10].MOM-3].[CF] THEN GO ECH; 15422000
IF BUFF<0 THEN 15423000
IF P(PRT[MIX,NX],TOP,XCH,DEL) THEN PRT[MIX,NX]~DATA ELSE 15424000
GO ECH ELSE 15425000
BEGIN; STREAM(J~JARROW[MIX],MIX,INDEX,R~[PRT[MIX,NX]], 15426000
D~ DATA~ BUFF.[15:15]-1); 15427000
BEGIN SI~J; SI~SI+1; DS~LIT" ";% %WF 15428000
DS~7 CHR; DS~LIT"/"; SI~SI+1;% %WF 15428100
DS~7CHR; DS~LIT"="; SI~LOC MIX; DS~2DEC; 15429000
MIX~DI; DI~DI-2; DS~FILL; DI~MIX; 15429500
DS~3LIT":R+"; SI~SI+4; DS~4 CHR; D~DI; DI~DI-4; 15430000
DS~3 FILL; DI~D; DS~LIT"="; SI~R; 15431000
IF SB THEN % DESCRIPTOR:TYPE OCTAL 15432000
16(DS~3 RESET; 3(IF SB THEN DS~SET ELSE DS~ 15433000
RESET; SKIP SB)) ELSE 15434000
DS~8 DEC; 15435000
DS~LIT"~"; DI~D; DI~DI+1; DS~7 FILL; 15436000
END; 15437000
SPOUTER(DATA INX M[BUFF.[15:15]-2],UNITNO,1); 15437100
END; % %844-15438000
END ELSE BEGIN % ABSOLUTE CORE ADDRESS OUTPUT REQUIRED %844-15438010
IF (INDEX AND NOT @707070707)!0 THEN GO ECH ELSE %844-15438020
BEGIN % %844-15438030
NX~INDEX.[45:3]&INDEX[42:39:3]&INDEX[39:33:3] %844-15438040
&INDEX[36:27:3]&INDEX[33:21:3];% %844-15438050
STREAM(INDEX,R~NX,D~DATA~BUFF.[15:15]-1);% %844-15438060
BEGIN DS~15 LIT" CORE LOCATION "; SI~LOC INDEX;% %844-15438070
SI~SI+3; DS~5 CHR; D~DI; DI~DI-5; DS~4 FILL;% 15438080
DI~D; DS~LIT"="; SI~R;% %844-15438090
16(DS~3 RESET; 3(IF SB THEN DS~SET ELSE %844-15438105
DS~RESET; SKIP SB)); %844-15438120
DS~LIT"~"; DS~D; DI~DI+1; DS~15 FILL; %844-15438130
END;% %844-15438140
SPOUT(DATA INX M[BUFF.[15:15]-2]);% %844-15438150
END % %844-15438160
END; GO X; % %844-15438170
ECH: PRTGAMES~1; 15439000
X: END; 15440000
$ SET OMIT = NOT(DCLOG AND DATACOM ) 15440999
PROCEDURE WHATMCP(BUFF); REAL BUFF; % FORMATS WM MESSAGE 15500000
BEGIN REAL X; 15501000
DEFINE BUFFSIZE=36#; % INCREASE THIS WITH MORE OPTIONS 15501100
X:=(BUFF:=SPACE(BUFFSIZE+30))+BUFFSIZE; 15501200
DISKWAIT(-X,30,MCPNAMESEG); 15501300
STREAM(ML:=MARKLEVEL,PL:=PATCHLEVEL,LL:=LOCALLEVEL 15501500
,N:=X+20+2|SYSNO,A:=BUFF); 15501600
BEGIN DS~LIT" "; SI~N; SI~SI+1; DS~7 CHR; DS~LIT"/"; 15502000
SI~SI+1; DS~7 CHR; DS~6 LIT" MARK "; 15502100
SI:=LOC ML; IF SC GEQ " " THEN; 15502200
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 15502300
ELSE DS:=CHR); DS:=LIT"."; 15502400
SI:=LOC PL; IF SC GEQ " " THEN; 15502500
6(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 15502600
ELSE DS:=CHR); DS:=2CHR; 15502700
SI:=LOC LL; IF SC GEQ " " THEN; 15502800
8(IF TOGGLE THEN IF SC="0" THEN SI:=SI+1 ELSE DS:=CHR 15502900
ELSE DS:=CHR); 15503000
DS ~ 10 LIT " INCLUDES ";% 15504000
$ SET OMIT = NOT(AUTODUMP) 15504999
DS ~ 9 LIT "AUTODUMP,"; 15505000
$ POP OMIT 15505001
$ SET OMIT = NOT(AUXMEM) 15505499
$ SET OMIT = NOT(BREAKOUT) 15505999
$ SET OMIT = NOT(B6500LOAD) 15506499
$ SET OMIT = NOT(CHECKLINK OR DEBUGGING) 15506999
$ SET OMIT = NOT(DATACOM) 15507499
$ SET OMIT = NOT(DCLOG AND DATACOM) 15507999
$ SET OMIT = NOT(DCSPO AND DATACOM) 15508499
$ SET OMIT = NOT(DEBUGGING) 15508999
$ SET OMIT = NOT(DFX) 15509499
$ SET OMIT = NOT(DISKLOG) 15509999
$ SET OMIT = NOT(DKBNODFX) 15510499
$ SET OMIT = NOT(DUMP OR DEBUGGING) 15510999
DS ~ 5 LIT "DUMP,"; 15511000
$ POP OMIT 15511001
$ SET OMIT = NOT(MONITOR) 15511499
$ SET OMIT = NOT(NEWLOGGING) 15511999
$ SET OMIT = NOT(PACKETS) 15512499
DS ~ 8 LIT "PACKETS,"; 15512500
$ POP OMIT 15512501
$ SET OMIT = NOT(RJE AND DATACOM) 15512999
$ SET OMIT = NOT(SAVERESULTS) 15513499
$ SET OMIT = NOT(SEPTICTANK) 15513999
$ SET OMIT = NOT(SHAREDISK) 15514499
$ SET OMIT = NOT(STATISTICS) 15514999
$ SET OMIT = NOT(WORKSET) 15515499
DS ~ 8 LIT "WORKSET,"; 15515500
$ POP OMIT 15515501
$ SET OMIT = NOT(WORKSETMONITOR) 15515999
DS ~ 15 LIT "WORKSETMONITOR,"; 15516000
$ POP OMIT 15516001
DI ~ DI-1; 15523000
A~ DI; 15524000
SI~ A; DI~ A; 15525000
IF SC!"," THEN 15526000
DI~ DI- 9; 15527000
DS~ LIT "~" 15528000
END; 15529000
IF M[3].[1:1] THEN % CM HAS BEEN DONE 15530000
BEGIN DISKWAIT(-X,30,0); 15530100
STREAM(N~X+10+5|SYSNO,BUFF); 15530200
BEGIN SI~BUFF; SI~SI+16; 15530300
L: IF SC NEQ "~" THEN BEGIN SI~SI+1; GO L; END; 15530400
BUFF~SI; DI~BUFF; 15530500
DS~18 LIT"-NEXT MCP WILL BE "; 15530600
SI~N; SI~SI+1; DS~7 CHR; DS~LIT"/"; 15530700
SI~SI+1; DS~7 CHR; DS~LIT"~"; 15530800
END; END; 15530900
END WHATMCP; 15533000
PROCEDURE WHATINTRINSIC(BUFF); VALUE BUFF; REAL BUFF; 15534000
BEGIN 15535000
REAL SIZE,LOC,INTWORD,WI,I; 15536000
LABEL EXIT; 15537000
IF INTSIZE=0 THEN 15539000
BEGIN ; 15540000
STREAM(BUFF); DS~14 LIT "NO INTRINSICS~"; 15541000
GO EXIT; 15542000
END; 15543000
COMMENT MAKE WI INTRINSIC PRESENT; 15544000
SIZE := (INTWORD:=INTRNSC[INTRNSC[0]]) INX 0; 15545000
LOC := SPACE(SIZE); 15546000
$ SET OMIT = NOT(AUXMEM) 15547000
DISKWAIT(-LOC,SIZE,INTWORD.[6:27]); 15548000
DISKWAIT(-(I:=SPACE(30)),30,0); 15549000
STREAM(X:=I+13+5|SYSNO,LOK:=LOC,BUFF); 15550000
BEGIN 15551000
SI:=LOK; SI:=SI+8; 15552000
10(SI:=SI+1; 15552100
7(IF SC="~" THEN JUMP OUT 2 TO L1; 15552200
IF SC="@" THEN SI:=SI+1 ELSE DS:=CHR)); 15552300
L1: SI:=X;DS:=3LIT" ("; 15552400
SI:=SI+1; DS:=7 CHR;DS:=LIT"/"; 15552500
SI:=SI+1; DS:=7 CHR;DS:=2LIT")~"; 15552600
END STREAM; 15552700
FORGETSPACE(LOC); FORGETSPACE(I); 15552800
EXIT: 15554000
END WHATINTRNSIC; 15555000
PROCEDURE COREPRINT(Q); VALUE Q; REAL Q; 15600000
COMMENT : THIS PROCEDURE COMPUTES AND TYPES THE AMOUNTS OF SAVE 15600050
AND OVERLAYABLE CORE IN USE FOR A GIVEN MIX OR ALL MIXES; 15600100
COMMENT : Q.[1:1] = 1 IF ALL MIXES DESIRED 15600120
Q.[CF] = MIX, Q.[9:9] = REMOTE TU/BU; 15600140
BEGIN REAL LINK,SIZE,D;% 15600300
ARRAY C[*]; 15600400
INTEGER A,N; 15600500
LABEL NXT; 15600600
C ~ [M[SPACE(MIXMAX+1)]] & (MIXMAX+1) [8:38:10]; 15600800
FOR A ~ 0 STEP 1 UNTIL MIXMAX DO C[A] ~ 0;% 15600950
C[0].[FF] ~ A ~ MSTART;% 15601000
WHILE A!0 DO % STEP THROUGH MEMORY LINKS 15601150
BEGIN IF (LINK ~ M[A]).[1:1] THEN GO TO NXT; 15601200
SIZE ~ LINK.[CF] - A; 15601400
IF LINK.[2:1] THEN SIZE ~ 0 & SIZE [CTF];% SAVE 15601500
C[LINK.[9:6]] ~ (*P*DUP)) + SIZE;% 15601600
NXT: A ~ LINK.[CF];% 15602200
END;% 15602300
A ~ -1; WHILE (A~A+1) { MIXMAX DO% 15602400
BEGIN IF Q.[1:1] OR Q.[CF] = A THEN IF C[A] ! 0 THEN 15602500
BEGIN; STREAM(N~N~C[A].[FF],D~[SIZE]);% 15602600
BEGIN SI ~ LOC N; DS ~ 8 DEC; END;% 15602620
STREAM(N~N~C[A].[CF],D~[LINK]);% 15602640
BEGIN SI ~ LOC N; DS ~ 8 DEC; END;% 15602660
JOBMESS(A,Q,":SAVE=",SIZE," OLAY=",LINK);% 15602680
END;% 15602690
END;% 15602700
IF Q.[1:1] THEN% DO TOTAL 15603900
BEGIN P(C[0]); 15604000
FOR A~1 STEP 1 UNTIL MIXMAX DO P(C[A],ADD);% 15604100
N ~ P; N ~ N.[FF] + N.[CF];% 15604200
STREAM(N,D~D~SPACE(4));% 15604250
BEGIN SI ~ LOC N; DS ~ 18 LIT "TOTAL MEM IN USE= "; 15604275
DS ~ 5 DEC; DS ~ LIT "~"; 15604300
DI ~ DI = 6; DS ~ 4 FILL;% 15604400
END STREAM; 15604500
SPOUT(D & Q[9:9:9]);% 15604600
END; 15604700
FORGETSPACE(C INX 0); 15604800
END COREPRINT; 15604900
$ SET OMIT = NOT(AUXMEM) 15604999
PROCEDURE LOGCOMMENT (Q); VALUE Q; REAL Q; 15610000
BEGIN 15611000
REAL I,J,K,L; 15612000
ARRAY LOG[*]; 15613000
L ~ SPACE(72); 15614000
STREAM (Q:D~L+5); 15615000
BEGIN SI ~ Q; 15616000
L: IF SC!"~" THEN BEGIN DS ~ CHR; GO TO L; END; 15617000
5(DS ~ 8 LIT " "); DI ~ DI-32; Q ~ DI; 15618000
END; 15619000
I ~ P.[33:15]; LOG ~ [M[L]] & (I=L+4)[8:38:10]; 15620000
LOG[3] ~ I ~ I-L-5; % NUMBER OF WORDS IN COMMENT 15621000
WHILE (J:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO MIDNIGHT; 15622000
LOG[2] ~ DATE.[18:30]; 15623000
LOG[1] ~ J; 15624000
LOG[0] ~ 99; 15625000
LOGSPACE([LOG[0]],I+9); 15626000
FORGETSPACE(LOG); 15627000
END; 15628000
REAL PROCEDURE KEYINSCAN(KTR,MIX); REAL KTR,MIX; 16034900
BEGIN 16035000
REAL TYPE=+1, TBLADDR; 16035100
% SCANS IN PUT BUFFER FROM SPO 16035200
% RETURNS ERROR FLAG IN MIX.[1:3] ... 16035300
% MIX.[1:1]=FLAG FOR EMPTY BUFFER (GROUP MARK ONLY) 16035400
% MIX.[2:1]=FLAG FOR NO INFO AFTER MIX INDEX 16035500
% MIX.[3:1]=FLAG FOR QMARK (CC) INPUT AS FIRST CHARACTER 16035600
% KTR IS INITIALLY THE ADDRESS OF SPO INPUT BUFFER 16035700
% KTR IS ASSIGNED NEXT CHARACTER LOCATION AFTER SCAN 16035800
% TYPE.[CF] IS ASSIGNED TABLE LOCATION (MIXMSG OR INFOMSG) 16035900
% TYPE.[1:5] IS ASSIGNED PROCEDURE NUMBER 16036000
% TYPE.[6:6] IS ASSIGNED MIXCODE 16036100
STREAM(MIX:=63, BUFF:=KTR :); % SCAN INPUT BUFFER 16036200
BEGIN 16036300
SI:=BUFF; 16036400
DI:=BUFF; DI:=DI-1; DS:=LIT"<"; % BACKSPACE CHARACTER 16036500
8(60(IF SC="~" THEN % END OF INPUT STRING 16036600
BEGIN 16036700
DS:=CHR; JUMP OUT 2 TO L; 16036800
END; 16036900
IF SC="<" THEN % BACK SPACE CHARACTER 16037000
BEGIN 16037100
DI:=DI-1; IF SC NEQ DC THEN DI:=DI-1; 16037200
END 16037300
ELSE DS:=CHR)); % END OF BACKSPACE CHECK 16037400
L: SI:=BUFF; DI:=LOC MIX; % CHECK FOR MIX INDEX 16037500
L1: IF SC=" " THEN 16037600
BEGIN 16037700
SI:=SI+1; GO TO L1; 16037800
END; 16037900
IF SC="~" THEN % EMPTY BUFFER 16038000
BEGIN 16038100
SKIP DB; DS:=SET; GO TO XXIT; % MIX.[1:1]=EMPTY BUFFER FLAG 16038200
END; 16038300
IF SC LSS "0" THEN GO TO XXIT; % NO MIX INDEX, SET "MIX"=63 16038400
IF SC GTR "9" THEN % QUESTION MARK, SET MIX.[3:1] 16038500
BEGIN 16038600
SI:=SI+1; SKIP 3DB; DS:=SET; GO TO XXIT; % MIX.[3:1]=QMARK FLAG16038700
END; 16038800
SI:=SI+1; IF SC LSS "0" THEN GO TO ONE; 16038900
IF SC LEQ "9" THEN 16039000
BEGIN 16039100
SI:=SI-1; DS:=2OCT; 16039200
END 16039300
ELSE 16039400
BEGIN 16039500
ONE: SI:=SI-1; DS:=OCT; 16039600
END; 16039700
L2: IF SC=" " THEN % SCAN TO NEXT VISIBLE CHARACTER 16039800
BEGIN 16039900
SI:=SI+1; GO TO L2; 16040000
END; 16040100
IF SC="~" THEN % NO INFORMATION AFTER MIX INDEX 16040200
BEGIN 16040300
DI:=LOC MIX; SKIP 2DB; DS:=SET; % MIX.[2:1]=ERROR FLAG 16040400
END; 16040500
XXIT: DI:=BUFF; DI:=DI-8; DS:=8LIT"INV KBD "; 16040600
BUFF:=SI; % SAVE LOCATION OF NEXT CHARACTER IN BUFFER 16040700
END STREAM; 16040800
IF P([KTR],STD,[MIX],SND).[1:3]=0 THEN % NOT QMARK,EMPTY OR ERROR 16040900
BEGIN 16041000
TBLADDR:=TYPE:=SPACE(KEYMSGSZ); 16041100
DISKWAIT(-TYPE,KEYMSGSZ,MESSAGETABLE[2].[22:26]); 16041110
STREAM(TBBL:=TYPE, BUFF:=KTR : TOG:=(MIX NEQ 63)); 16041200
BEGIN 16041300
SI:=TBBL; SI:=SI+1; DI:=BUFF; DI:=DI+2; 16041400
NEXT: CI:=CI+TOG; GO TO NOMIX; 16041500
MIX: IF SC GEQ 1 THEN GO TO OK ELSE % MIX SPECIFIED 16041550
BEGIN % BUT THIS IS NOT 16041600
SI:=SI+8; GO TO MIX; % A MIX MESSAGE. 16041650
END; 16041700
NOMIX: IF SC GTR 1 THEN % MIX NOT SPECIFIED 16041750
BEGIN % BUT THIS IS A 16041800
SI:=SI+8; GO TO NOMIX; % MIX MESSAGE. 16041850
END; 16041900
OK: SI:=SI+1; DI:=DI-2; 16042000
IF SC="~" THEN % END OF TABLE 16042100
BEGIN 16042200
TBBL:=TALLY; GO TO XT; 16042300
END; 16042400
IF 2 SC!DC THEN % NOT MATCHING ENTRY 16042450
BEGIN 16042500
SI:=SI+5; GO TO NEXT; 16042550
END; 16042600
TOG:=DI; DI:=LOC TBBL; SI:=SI+2; DS:=2 OCT; % SWITCH VALUE 16042650
SI:=SI-4; DI:=LOC TBBL; DS:=2CHR; % PROCED & MIXCODE 16042700
SI:=TOG; 16042800
L: IF SC=" " THEN 16042900
BEGIN 16043000
SI:=SI+1; GO TO L; 16043100
END; 16043200
BUFF:=SI; 16043300
XT: END STREAM STATEMENT; 16043400
P( [KTR],STD, .TYPE,STD); 16043500
FORGETSPACE(TBLADDR); 16043550
END % IF NOT QMARK, EMPTY OR ERROR 16043600
ELSE % QMARK, EMPTY OR ERROR 16043620
IF MIX.[3:1] THEN % QMARK 16043640
BEGIN MIX:=63; 16043660
TYPE:=VCC&@104[1:37:11]; 16043680
END 16043700
ELSE TYPE:=0; 16043750
END PROCEDURE KEYINSCAN; 16043800
PROCEDURE KEYIN0(B,KTRX); VALUE B,KTRX; REAL B,KTRX; 16044000
16045000
BEGIN 16046000
INTEGER ZZSTA; 16047000
REAL BUFF, KTR, TYPE, MIX, A, I, J, K; 16048000
REAL U = A; 16048100
ARRAY BUFA = BUFF[*]; 16049000
16050000
16051000
16052000
LABEL DSM, CUTY, FORGET, ERROR, EXIT 16053000
,AX ,IL ,QT ,OU ,WY ,RY ,DS ,TF ,RM ,DP 16054000
,DD ,ST ,CM ,SV ,CL ,BK ,TI ,PR ,RO ,IT 16055000
,WI ,RXIT ,RC 16056000
16057000
16058000
16059000
; 16060000
SWITCH S:= ERROR 16061000
,AX ,IL ,IL ,QT ,OU ,WY ,RY ,DS ,DS ,TF 16062000
,TF ,RM ,DP ,DD ,DD ,DD ,ST ,CM ,SV ,CL 16063000
,BK ,RXIT ,RY ,RXIT ,RXIT ,RI ,PR ,RO ,RO ,IT 16064000
,WI ,RXIT ,RC 16065000
16066000
16067000
16068000
; 16069000
SUBROUTINE SPOIT; M[BUFF-1]:=B AND @7570000000000; 16070000
16071000
BUFF :=KTRX.[15:15]; 16072000
MIX :=KTRX.[ 9:6 ]; 16073000
TYPE :=KTRX.[ 2:7 ]; 16074000
KTR :=KTRX.[15:33]; 16075000
ZZSTA :=0 & (M[BUFF-2])[9:9:9]; 16076000
GO TO S[TYPE]; 16077000
AX: 16078000
I := BUFF; 16079000
GO TO RXIT; 16080000
IL: 16081000
IF (I:=ANVIL(TYPE=2,KTR)) GTR PSEUDOMAXT THEN % IL=2, UL=3 16082000
IF I LSS 70 THEN GO TO ERROR; 16083000
TYPE := 2; % IL 16084000
IF I GTR PSEUDOMAXT THE BUFF:=1; 16085000
GO TO RXIT; 16086000
OU: 16087000
STREAM(A:="LP" : B:="MT", C:="DK", D:="CP", KTR); 16088000
BEGIN 16089000
SI := KTR; 16090000
DI := LOC A; DI := DI+6; 16091000
TALLY:=1; IF SC="~" THEN GO TO XT; 16092000
TALLY:=2; IF 2 SC=DC THEN GO TO XT; 16093000
TALLY:=3; SI:=SI-2; DI:=DI+14; IF 2 SC=DC THEN GO TO XT; 16094000
TALLY:=4; SI:=SI-2; DI:=DI+6; IF 2 SC=DC THEN GO TO XT; 16095000
TALLY:=5; SI:=SI-2; DI:=DI+6; IF 2 SC=DC THEN GO TO XT; 16096000
TALLY:=0; 16097000
XT: A := TALLY; 16098000
END; 16099000
IF(I:=P) = 0 THEN GO TO ERROR; 16100000
GO TO RXIT; 16101000
WY: 16102000
IF MIX LSS 63 THEN GO TO RXIT; % <MIX> WY 16103000
SPOIT; 16104000
A:=0; 16105000
FOR I:=1 STEP 1 UNTIL MIXMAX DO 16106000
IF *[JARROW[I]] NEQ 0 THEN 16107000
IF REPLY[I] LSS 0 THEN REPLY[A:=I]:=VWY; 16108000
IF A!0 THEN GO TO FORGET; 16109000
M[BUFF-1]:=FLAG(-"NULL "); 16109500
GO TO ERROR; 16110000
DS: 16111000
IF MIX=63 THEN % "DS A/B" 16112000
BEGIN 16113000
NAMEID(J,KTR); NAMEID(K,KTR); NAMEID(K,KTR); 16114000
FOR MIX:=1 STEP 1 UNTIL MIXMAX DO 16115000
IF *[JARROW[MIX]] NEQ 0 THEN 16116000
IF (J EQV ABS(JAR[MIX,0]))=(NOT 0) THEN 16117000
IF (K EQV ABS(JAR[MIX,1]))=NOT 0 THEN 16118000
BEGIN 16118100
TABCNT[MIX]:=TABCNT[MIX]+1; 16118200
GO TO DSM; 16118300
END; 16118400
GO TO ERROR; % NOT FOUND 16119000
END; % IF MIX NOT GIVEN 16120000
IF JARROW[MIX] NEQ 0 THEN 16121000
BEGIN 16122000
DSM: JAR[MIX,6].[1:1]:=((TYPE=9) OR (TYPE=20)); % DS=8,SD=9,CL=20 16123000
TERMINATE(MIX&(IF B.[9:9] GTR 0 THEN 61 ELSE 3)[CTF]); 16124000
HALT; 16125000
NOPROCESSTOG:= NOPROCESSTOG-1; 16126000
GO TO FORGET; 16127000
END; 16128000
GO TO ERROR; 16129000
TF: 16130000
IF TYPE=11 THEN SPOIT; % SF=11 16131000
CHANGEFACTOR(KTR,TYPE=10); % TF=10,SF=11 16132000
GO TO EXIT; 16133000
RM: 16134000
Reference in New Issue View Git Blame Copy Permalink