github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-21 17:54:42 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/SYMBOL/DCMCP.esp_m
Paul Kimpel 0363618629 Commit DCMCP transcription as of 2012-06-30; commit minor tweaks to 
processor panel prototype; commit Nigel's preliminary changes to 
Processor module
2012-06-30 13:52:31 +00:00

5305 lines
466 KiB
Plaintext
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 % FUOND 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
Reference in New Issue View Git Blame Copy Permalink