github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-19 01:06:45 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/SYMBOL/DCMCP.esp_m

9281 lines
816 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 % FOUND A POSSIBLE SQUASH SITUATION 06112000
BEGIN 06112100
IF INUSEOK THEN MOVEANDFIX; 06112200
GO AGAIN; 06112300
END ELSE % TIME TO WRAP IT UP FOR THIS EU UNLESS.... 06112400
IF CONFLICT THEN IF NOT PASSTWO THEN % ..CONFLICTS EXIST 06112500
BEGIN 06112600
PASSTWO:=TRUE; 06112700
GO AGAIN; 06112800
END ELSE 06112900
BEGIN % CLEAN-UP PASS AFTER CONFLICTS RESOLVED. 06113000
PASSTWO:=CONFLICTS:=0; 06113100
GO AGAIN; 06113200
END; 06113300
STOPSQ: FOR I:=D STEP 1 UNTIL S DO UT[I]:=ABS(P(DUP.LOD)&0[2:2:1]); 06113400
IF NOT EUNOTSQUASHED THEN 06113500
$ SET OMIT = NOT SHAREDISK 06113600
DISKWAIT( R,AVSIZ,DISKAV); 06114300
FORGETSPACE(R); 06114400
P(1); SQUASHMESS; 06114500
STOPIT: IF STOP THEN GO OUT; % STOPCK GOT US HERE 06114600
END EU LOOP; 06114700
OUT: 06114800
FORGETSPACE(A1); FORGETSPACE(A2); FORGETSPACE(A3); 06114900
$ SET OMIT = NOT SHAREDISK 06115000
SDXIT: 06115500
FORGETSPACE(A4); FORGETSPACE(A5); 06115600
CELL:=PRTVALUE; 06115700
STREAM(A:=BUFF.[15:15]-1); DS:=13 LIT" END SQUASH.~"; 06115800
SPOUT(BUFF.[15:15]-1); 06115900
$ SET OMIT = SHAREDISK 06115990
UNLOCKDIRECTORY; 06116000
$ POP OMIT 06116010
UNLOCKTOG(USERDISKMASK); 06116100
NOPROCESSTOG:=NOPROCESSTOG-1; 06116200
KILL([MSCW]); 06116300
END SQUASHING; 06116400
PROCEDURE CHANGEABORT(X); VALUE X; REAL X; FORWARD;% 06179000
REAL LOOKQ; 06179200
PROCEDURE SIGNOFF(VECTOR,FILEBLOCK,PKT); 06180000
VALUE VECTOR,FILEBLOCK,PKT; 06181000
ARRAY VECTOR[*],FILEBLOCK[*];% 06182000
REAL PKT; 06182100
BEGIN ARRAY NAME LOG; 06183000
INTEGER N,L,I,J,TIMEX;% 06184000
INTEGER MIX; 06184100
$ SET OMIT = NOT STATISTICS 06184199
REAL TIMEAX,T,A,Q,ESED; 06185000
$ SET OMIT = NOT(PACKETS) 06185099
REAL UNITNO; 06185100
INTEGER ARRAY PM[*]; 06185105
$ POP OMIT 06185110
$ SET OMIT = NOT(WORKSET AND WORKSETMONITOR) 06185111
REAL DD; 06185112
$ POP OMIT % WORKSET AND WORKSETMONITOR 06185113
SUBROUTINE TIMEIT;% 06186000
BEGIN CHANGEABORT(0);% 06187000
WHILE (NT2:=XCLOCK+P(RTR)) GEQ WITCHINGHOUR DO 06188000
MIDNIGHT; 06188100
LOG[TIMEAX+2] ~ NT2;% 06189000
$ SET OMIT = NOT(STATISTICS) 06189099
STOPLOG(P1MIX,0); 06190000
MIX~P1MIX; P1MIX~0; 06190100
IDLETIME;% 06191000
OLDIDLETIME ~ (LOG[TIMEX] ~ VECTOR[3]+% 06192000
PROCTIME[MIX])+OLDIDLETIME; 06193000
PROCTIME[MIX] ~ -VECTOR[3];% %127-06193500
LOG[TIMEX+1]~VECTOR[4]+IOTIME[MIX]; 06194000
$ SET OMIT = NOT WORKSET 06194890
LOG[TIMEX+2] ~ OLAYTIME[MIX]; %710-06194900
$ SET OMIT = WORKSET%710-06194990
$ SET OMIT = NOT(WORKSET AND WORKSETMONITOR) 06195090
IF WKSETMONITOR AND (DD=0) THEN 06195095
BEGIN 06195100
STREAM(N1 := VECTOR[0], N2 := VECTOR[1], 06195105
T1 := ((LOG[TIMEX]+0.5)/60 DIV 1), 06195110
T2 := ((LOG[TIMEX+1]+0.5)/60 DIV 1), 06195115
T4 ~ (OLAYTIME[MIX]+59) DIV 60, % OLAY I/O TIME IN SECS %710-06195118
T3:=(((LOG[TIMEAX+2]-VECTOR[5].[24:24])+0.5)/60 DIV 1), 06195120
DV:=0, DD := DD := SPACE(10)); 06195125
BEGIN 06195130
SI:=LOC N; DS:=LIT" "; 06195135
2(SI:=SI+1; DS:=7CHR; DS:=LIT" "); 06195140
DS:=4LIT"CPU="; 06195145
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195150
DS:=5LIT" I/O="; 06195155
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195160
DS~ 6LIT" OLAY="; %710-06195161
DS~ 6DEC; DV~ DI; DI~ DI-6; DS~ 5FILL; DI~ DV; %710-06195162
DS:=6LIT" ELAP="; 06195165
DS:=6DEC; DV:=DI; DI:=DI-6; DS:=5FILL; DI:=DV; 06195170
DS:=LIT"~"; 06195175
END STREAM STATEMENT; 06195180
SPOUT(DD); 06195185
END; 06195190
$ POP OMIT % WORKSET AND WORKSETMONITOR 06195195
STREAM(A~VECTOR[5].[1:23]:B~0);% 06196000
BEGIN SI ~ LOC A; DI ~ LOC A; DS ~ 8 DEC END;% 06197000
LOG[TIMEAX] ~ P(XCH);% 06198000
LOG[TIMEAX+1] ~ VECTOR[5].[24:24];% 06199000
$ SET OMIT = NOT(STATISTICS) 06199099
NT4 ~ VECTOR[2].[8:10];% 06200000
LOG[TIMEAX+3] ~ IF VECTOR[1] < 0 THEN (NT4= 99) 06201000
+2 ELSE NT4 = 3;% 06202000
LOG[TIMEAX+3].[1:30]~ DATE.[18:30]; 06202100
LOG[TIMEAX+4]:=USERCODE[MIX]; 06203000
$ SET OMIT = NOT(DCLOG AND DATACOM) 06203099
IF TABCNT[MIX]!0 THEN 06203600
BEGIN T:=CLOCK+900; 06203650
COMPLEXSLEEP(TABACNT[MIX]=0 OR CLOCK>T); 06203700
END; 06203750
$ SET OMIT = NOT (DATACOM AND NOT DCLOG) 06203790
PRTROW[MIX].[PSF]:=0; 06204000
$ SET OMIT = NOT(PACKETS) 06205009
UNITNO:=PSEUDOMIX[MIX]; 06205010
PSEUDOMIX[MIX]:=0; 06205020
PM[0]:=LOG[TIMEX ]/60; 06205030
PM[1]:=LOG[TIMEX+1]/60; 06205040
$ SET OMIT = NOT(WORKSET) OR OMIT %759-06205049
PM[2]:=OLAYTIME[MIX]/60; %759-06205050
$ POP OMIT 06205051
$ POP OMIT %759-06205052
USERCODE[MIX] := 0; 06205100
STREAM(S~[NFO[(MIX-1)|NDX]]);% 06205200
BEGIN DS~8 LIT "0"; DI~S; DS~2 WDS; END;% 06205300
$ SET OMIT = NOT STATISTICS 06205540
JARROW[MIX]:=PRTROW[MIX]:=0; 06206000
END TIMET; 06206100
$ SET OMIT = NOT(PACKETS) 06206109
SUBROUTINE MESSAGE; 06206110
IF UNITNO!0 OR (VECTOR.[24:9]!0) THEN 06206120
BEGIN 06206130
STREAM(A:=[VECTOR[0]],MIX,B:=[PM[0]],T:=T:=SPACE(10)); 06206140
BEGIN DS:=5LIT" FOR";SI:=A;SI:=SI+1;DS:=7CHR; 06206150
DS:=LIT"/";SI:=SI+1;DS:=7CHR;SI:=LOC MIX; 06206160
DS:=LIT"=";DS:=2DEC; 06206170
A:=DI;DI:=DI-2;DS:=FILL;DI:=A; SI:=B; 06206175
DS:=10 LIT ": PROCESS="; DS:=5 DEC; %759-06206180
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; 06206190
DS:=10 LIT " SECS, IO="; DS:=5 DEC; %759-06206200
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; 06206205
$ SET OMIT = NOT(WORKSET) OR OMIT %759-06206209
DS:=12 LIT " SECS, OLAY="; DS:=5 DEC; %759-06206210
A:=DI;DI:=DI-5;DS:=4FILL;DI:=A; %759-06206215
$ POP OMIT %759-06206216
DS:=LIT"~"; 06206220
END; 06206230
SPOUTER(T,IF VECTOR.[24:9] NEQ 0 THEN 06206240
VECTOR.[24:9] ELSE UNITNO,64); 06206250
END; 06206260
$ POP OMIT 06206261
A ~ VECTOR[6].[33:15];% 06207000
ESED:=VECTOR[2].[2:1]; 06207100
T:=Q:=((L:=VECTOR[6].[18:15])+(IF ESED THEN N~0 ELSE 06208000
N:=FILEBLOCK.[8:10])+60) DIV 25|27; 06209000
LOG:=[M[TYPEDSPACE(T,LOGAREAV)]];% %167-06210000
M[LOG INX NOT 1].[9:6] ~ 0;% 06211000
$ SET OMIT = NOT(PACKETS) 06211099
PM:=[M[SPACE(5)]]&5[8:38:10]; 06211100
M[PM INX NOT 1].[9:6]:=0; 06211200
$ POP OMIT 06211201
J ~ A;% 06212000
DO BEGIN I ~ I+27;% 06213000
DISKIO( T ,-( LOG INX I),26,J);% 06214000
SLEEP([T],IOMASK);% 06215000
J ~ LOG[I+1];% 06216000
END UNTIL J=0 OR I+53>Q;% 06217000
IF VECTOR[2].[8:10]=0 THEN L ~ LOG[29]; 06217100
IF(I:=(L-5) MOD 25+I+7) LSS Q-3 THEN 06218000
IF I MOD 27 = 0 THEN% 06219000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06220000
I ~ I+2 END;% 06221000
$ SET OMIT = NOT(STATISTICS) 06221099
LOG[I]:= IF VECTOR[0] LSS 0 06222000
THEN IF VECTOR[0]=(-"COBOL ") THEN 2 06222100
ELSE IF VECTOR[0]=(-"FORTRAN") THEN 6 06222200
ELSE IF VECTOR[0]=(-"BASIC ") THEN 7 06222300
ELSE IF VECTOR[0]=(-"XALGOL ") THEN 9 06222400
ELSE IF VECTOR[0]=(="TSPOL ") THEN 10 06222500
ELSE IF VECTOR[0]=(-"COBOL68") THEN 11 06222550
ELSE 1 ELSE 0; 06222600
LOG[I+1] ~ N DIV 5;% 06223000
IF(I:=(TIMEX:=I+2)+3) LSS Q-1 THEN 06224000
IF I MOD 27 = 0 THEN% 06225000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06226000
I ~ I+2;% 06227000
END;% 06228000
I ~ (TIMEAX ~ 1)+5;% 06229000
IF NOT ESED THEN%IF JOB ES-ED THEN NO FPB ENTRIES 06229100
FOR J ~ 5 STEP 5 UNTIL N DO% 06230000
IF FILEBLOCK[J-1]=0 THEN LOG[TIMEX -1]~*P(DUP)-1 ELSE 06230100
BEGIN IF I MOD 27 = 0 THEN% 06231000
BEGIN LOG[I] ~ LOG[I+1] ~ 0;% 06232000
I ~ I+2 END;% 06233000
IF I+4 LEQ Q THEN 06233100
STREAM(A~[FILEBLOCK[J-5]],B~[LOG[I]]);% 06234000
BEGN SI ~ A; DS ~ 5 WDS END;% 06235000
IF I+4 LEQ Q THEN 06235100
IF LOG[I+4] < 0 THEN 06236000
BEGIN LOG[I+4] ~ *P(DUP)+CLOCK+P(RTR);% 06237000
LOG[I+3].[24:12]~P(DUP,DUP).[24:12]+TINU06238000
[NT1~P(XCH).[36:6]-1].[18:12];% 06239000
TINU[NT1].[18:12] ~ 0;% 06240000
END;% 06241000
IF LOG[I+2].[18:30]=0 THEN 06241100
LOG[I+2].[18:30]:=DATE.[18:30];%ENTER CURR DATE 06241200
I ~ I+5% 06242000
END;% 06243000
N ~ LOG[TIMEX -1]|5; 06243100
FORGETSPACE(FILEBLOCK);% 06244000
J ~ 0;% 06245000
IF VECTOR[2].[8:10] = 1 THEN% 06246000
BEGIN DO J ~ J+27 UNTIL LOG[J+1] = 0;% 06247000
WHILE J+27 LSS I AND I LSS Q DO% 06248000
BEGIN LOG[J+1] ~ GETESPDISK;% 06249000
J ~ J+27;% 06250000
END;% 06251000
I ~ 27;% 06252000
TIMEIT;% 06253000
LOG[29]~5|LOG[40]+20; 06253500
DO BEGIN DISKIO(T,LOG INX I,26,A);% 06254000
A ~ LOG[I+1];% 06255000
I ~ I+27;% 06256000
SLEEP([T],IOMASK);% 06257000
END UNTIL A = 0;% 06258000
END% 06259000
ELSE BEGIN 06260000
DO BEGIN J~J+27; 06260100
FORGETESPDISK(A);% 06261000
A ~ LOG[J+1];% 06262000
END UNTIL A = 0;% 06263000
IF LOGFREE=0 THEN TIMEIT ELSE 06263100
BEGIN A~J+29; 06263200
LOG[29]~3; 06265000
I ~ I+6;% 06266000
WHILE (J ~ J+27) < I DO% 06267000
BEGIN A ~ A+25;% 06268000
STREAM(X~[LOG[J]],Y~[LOG[A]]);% 06269000
BEGIN SI ~ X; DS ~ 25 WDS END;% 06270000
IF TIMEX } A THEN TIMEX ~ TIMEX-2; 06271000
IF TIMEAX } A THEN TIMEAX ~ TIMEAX-2; 06272000
END;% 06273000
N ~ (N+L) DIV 5+3;% 06278000
L ~ 28;% 06279000
IF TIMEX+2 LSS Q AND TIMEAX+4 LSS Q THEN 06279100
TIMEIT; LOGSPACE(L+1 INX LOG,(N-1)|5); 06280000
END;% 06327000
END;% 06328000
$ SET OMIT = NOT(PACKETS) 06328099
MESSAGE; FORGETSPACE(PM); 06328100
IF UNITNO!0 THEN 06328200
DRAINO(UNITNO,(VECTOR[2].[8:10]!1) OR (PKT!0), 06328300
((VECTOR[1]<0) OR (VECTOR[2].[8:10]=3)) 06328400
%VECTOR[6][1:1:1]); 06328500
$ POP OMIT 06328501
FORGETSPACE(LOG);% 06329000
END SIGNOFF;% 06330000
PROCEDURE USERDISKSPECIALCASE(Q,R,UT,J) ; 06350000
VALUE Q,J; REAL R,J; INTEGER Q; ARRAY UT[*] ; 06350300
BEGIN 06350600
REAL BUFF=Q,N=J,Z=UT,E=R ; 06351000
$ SET OMIT = NOT(SHAREDISK ) 06351050
$ SET OMIT = SHAREDISK 06351100
REAL NEU,NT; ARRAY UA[*]; 06351104
DEFINE U=AVTABLE #, AVS=B #, NEU1=J-1 #, NEU2=NT-1 #; 06351105
$ POP OMIT 06351106
INTEGER NT1,NT3,NT4,B ; 06351250
LABEL L1,L2,L3,UP,PU,BD,WHY,M1,T10 ; 06351500
SWITCH SW,~L1,L2,L3 ; 06351800
IF Q!0 THEN GO SW[Q-1] ; 06352000
$ SET OMIT = NOT(SHAREDISK ) 06352490
L1: BUFF:=R; Z:=0; UNLOCKTOG(USERDISKMASK); 06353500
IF N LEQ RESERVEDISKSIZE THEN% CALL OUT RESERVES 06353510
IF (Z:=DIRECTORYSEARCH("RESERVE","DISK ",6)) NEQ 0 THEN 06353530
BEGIN FORGETSPACE(Z); 06353540
IF N>0 THEN 06353541
$ SET OMIT = PACKETS 06353542
BEGIN STREAM(Z:=Z:=SPACE(3)); 06353545
DS!23 LIT "**RESERVE/DISK REMOVED~"; 06353550
SPOUTER(Z,25,(NOT LIBMSG) AND 1); %523-06353551
END; 06353552
FORGETSPACE(BUFF); P(XIT); %528-06353555
END OF RESERVE CALL UP; 06353570
IF AUTOUNLD THEN 06353580
BEGIN P(P1MIX); AUTOUNLD:=P1MIX:=0; 06353590
STREAM(A:=DATE,Z:=Z:=SPACE(10)+2); 06353600
BEGIN DS:=23 LIT"CC UNLOAD EXPIRED TO XP"; 06353610
SI:=LOC A; SI:=SI+3; DS:=5 CHR; 06353620
DS:=9 LIT " =/=;END."; 06353630
END; 06353640
INDEPENDENTRUNNER(P(.CONTROLCARD),Z&31[3:43:5],192); 06353650
P1MIX:=P; 06353660
IF N GEQ 0 THEN 06353670
BEGIN STREAM(Z:=Z:=SPACE(10)); 06353680
DS:=18 LIT"18 AUTOUNLD RESET~"; 06353690
SPOUT(Z); 06353700
END END AUTOMATIC UNLOADING; 06353710
IF NOT N.[2:1] THEN 06353720
BEGIN IF P1MIX!0 THEN 06354000
BEGIN 06354100
NT1 ~ NOTERMSET(P1MIX); % NOTE: NT1 IS LOCAL %537-06354200
WHY: STREAM(J:=JARROW[P1MIX],P1MIX,N,BUFF); 06355000
BEGIN DS~14 LIT "#NO USER DISK:"; 06356000
SI~J; SI~SI+1; DS~7 CHR; 06357000
DS~LIT "/"; SI~SI+1; DS~7 CHR; 06358000
SI~LOC P1MIX; DS~LIT "="; DS~2 DEC; 06359000
J:=DI; DI:=DI-2; DS:=FILL; DI:=J; DS:=LIT"-"; 06359500
SI:=LOC N; DS:=8 DEC; DS:=7 LIT" SEGS.~"; 06360000
DI:=DI-15; DS:=7 FILL; 06360500
END; 06360505
SPOUT(BUFF); 06360510
IF AUTODS AND NOTERMSET(P1MIX) THEN %747-06360515
TERMINATE(P1MIX&61[CTF]) ELSE %747-06360516
BEGIN %747-06360517
REPLY[P1MIX]:=-VWY&VOK[36:42:6]; 06360520
COMPLEXSLEEP((REPLY[P1MIX] GTR 0) OR 06360530
(TERMSET(P1MIX) AND NT1)); %537-06360540
END; %747-06360542
IF NT1 THEN %537-06360545
IF TERMSET(P1MIX) THEN 06360550
BEGIN PRTROW[P1MIX].[7:1]~1; 06360560
GO TO INITIATE; 06360570
END; 06360580
IF NOT WHYSLEEP(VWY&VOK[36:42:6]) THEN 06360590
BEGIN BUFF~SPACE(10); 06360600
GO TO WHY; 06360610
END; 06360620
END ELSE 06361000
BEGIN 06361010
STREAM(N,BUFF); 06361100
BEGIN DS:=20 LIT"#NO USER DISK:MCP - "); 06361200
SI:=LOC N; DS:=8 DEC; 06361300
DS:=6 LIT" SEGS~"; 06361400
DI:=DI-14; DS:=7 FILL; 06361500
END; 06361600
SPOUT(BUFF); 06361610
NT1:=0; DO SLEEP([CLOCK], NOT CLOCK) 06361700
UNTIL (NT1~NT1+1)=30); 06361705
END; 06361710
END ELSE FORGETSPACE(BUFF); 06365110
P(XIT) ; 06380070
L2: U[J]:=E; E:=NEU:=(NT:=NEUP.NEUF)+2+(NT+1)DIV 2; P(NT); J:=1; 06380100
$ SET OMIT = SHAREDISK 06380120
NT1:=NT+NT+NT; FORGETSPACE(UT); FIXARRAY(UA,NT2,NT1); E:=0; 06380140
$ POP OMIT 06380141
UP: IF (NT4:=E MOD 30) LSS (NT3:=(NT1:=U[J].STARTWRD) MOD 30) 06380150
THEN NT4:=NT3 ; 06380200
IF (NT2:=(Q:=U[J] AND NUMENTM)+NT4) GTR 1023 06380250
OR ((Q+E+1) DIV 30+1-E DIV 30) GTR 34 THEN 06380300
BD: BYBY("ODISK IS TOO CHECKERED...PLEASE COMPACT IT~",43) ; 06380350
DISKWAIT(-((UA[NEU1]:=(UA[NEU2+J]:=SPACE(NT2))+NT4)-NT3),Q+NT3, 06380400
USERDISKBOTTOM~NT1 DIV 30) ; 06380450
$ SET OMIT = NOT(SHAREDISK ) 06380490
$ SET OMIT = SHAREDISK 06380520
IF J=1 THEN B:=UA.[CF]+NT+NT-1 ; 06380525
$ POP OMIT 06380526
M[B+J]:=U[J]&E[TOSTARTWRD] ; 06380550
IF (NT1:=Q DIV 4) LSS AVDIFFMIN THEN NT1:=AVDIFFMIN ; 06380600
IF (E:=E+Q+NT1) GTR AVTMAX THEN GO TO BD; 06380650
IF P(DUP) GEQ J:=J+1 THEN GO UP; E:=E-NT1; J:=1 ; 06380700
PU: NT2:=(NT3:=P(M[B+J],DUP).STARTWRD)+NT5:=P(XCH) AND NUMENTM ; 06380750
IF P(DUP)!J THEN IF (NT2-1)DIV 30=(NT4~M[B+J+1].STARTWRD)DIV 30 THEN06380800
MOVE(NT1~NT2 MOD 30,UA[NEU1]+NT5-NT1,NT1~UA[NEU1+1]-NT4 MOD 30); 06380850
DISKWAIT(UA[NEU1]-NT1~NT3 MOD 30,NT1~NT5,USERDISKBOTTOM+NT3 DIV 30);06380900
$ SET OMIT = NOT(SHAREDISK) 06380924
FORGETSPACE(UA[NEU2+J]); 06380950
IF P(DUP) GEQ J:=J+1 THEN GO PU ; 06381000
$ SET OMIT = SHAREDISK 06381020
MOVE(NT,[UA[NT+NT]].[AVTABLE[1]]) ; 06381070
$ POP OMIT 06381071
$ SET OMIT = NOT(SHAREDISK ) 06381075
FORGETSPACE(UA) ; 06381085
$ SET OMIT = NOT(SHAREDISK ) 06381095
P(DEL,Q&AVS[TOSIZE] OR M,RTN) ; 06381250
L3: P(U[NEUP.NEUF+2+(Q:=J DIV P(M1)) DIV 2],IF Q THEN P.[8:20] ELSE 06381300
P.[28:20]) ; 06381310
IF U[Q+1].SPEED = 2 THEN 06381320
BEGIN % 40-MILL MASK CONSTRUCTION. 06381330
Q:=P ; 06381335
STREAM(S:=0:Q); 06381340
BEGIN 06381345
SI:=LOC Q; SKIP 28SB; DI:=LOC S; SKIP 8DB; 06381350
5(4(IF SB THEN DS:=SET ELSE SKIP DB;SKIP SB); SKIP 4 DB); 06381355
SI:=LOC Q; SKIP 28 SB; DI:=LOC S; DI:=DI+2; 06381360
5(4(IF SB THEN DS:=SET ELSE SKIP DB;SKIP SB); SKIP 4 DB); 06381365
END STREAM; 06381380
END ; 06381390
STREAM(MSG:=0:V:=47-(J:=((Q:=J MOD P(M1))+ABS(R)-1) DIV P(T10)), 06381395
W:=1+J-Q DIV P(T10)); 06381400
BEGIN DI:=LOC MSK; SKIP V DB; DS:=W SET; END; 06381405
P(LND,LNG,0,LNG,=,RTN); 06381410
M1::: @3641100; % DECIMAL 1000000. 06381450
T10::: @23420; % DECIMAL 10000. 06381500
END OF USERDISKSPECIALCASE ; 06381550
PROCEDURE GETMOREOLAYDISK(MIX);% 06400000
VALUE MIX;% 06401000
INTEGER MIX;% 06402000
BEGIN INTEGER I=+1,% 06403000
J=+2,% 06404000
T=+3;% 06405000
ARRAY A=+4[*];% 06406000
REAL MSCW=-2; 06406500
REAL RCW=+0;% 06407000
LABEL EXIT;% 06408000
DEFINE DALOCMAXSZ = 06408100
$ SET OMIT = NOT(AUXMEM) 06408199
$ SET OMIT = AUXMEM 06408299
127#; %DALOC SIZE MUST = 9 INIITALLY. 06408300
$ POP OMIT 06408301
P(0, 0, 0, 0); TOGLE ~ TOGLE OR STACKMASK;% 06410000
IF (T~DALOC[MIX,0].[CF]+1)=DALOCMAXSZ THEN BEGIN 06411000
TERMINATE (MIX&111[CTF]); %517-06411010
GO TO EXIT; END; 06411030
IF T=DALOCROW[MIX].[8:10] THEN% 06412000
BEGIN IF (J~T+P(DUP) - 1)=129 THEN J~DALOCMAXSZ; 06413000
WHILE (I := GETSPACE(J, 0, 3)+2)=2 DO 06414000
SLEEP([CLOCK], NOT CLOCK); 06415000
MOVE(T, DALOCROW[MIX], I); 06416000
FORGETSPACE(DALOCROW[MIX]); 06417000
DALOCROW[MIX] := (*P(DUP)) & I[CTC] & J[8:38:10]; 06417500
M[I-2].[9:6] := MIX; 06418000
END AIT TYPE ACTION;% 06419000
IF (I ~ GETUSERDISK(500 OR MEMORY))=0 THEN GO TO EXIT;% 06420000
DALOC[MIX,0] ~ (*P(DUP))&(T+1)[CTC];% 06421000
DALOC[MIX,T] ~ I;% 06422000
DALOC[MIX,T+1] ~ 0;% 06423000
EXIT: OLAYMASK ~ TWO(MIX) OR OLAYMASK;% 06424000
KILL([MSCW]); 06425000
END GET MORE OVERLAY DISK FOR A MIX INDEX;% 06426000
REAL PROCEDURE SECURITYCHECK(MID,FID,USERID,HEADER); 06460000
VALUE MID,FID,USERID; 06460100
REAL MID,FID,USERID,HEADER; 06460200
% MID MULTI FILE ID OF FILE TO BE CHECKED 06460300
% FID FILE ID OF FILE TO BE CHECKED 06460400
% USERID USER IDENTIFICATION 06460500
% HEADER 06460600
% >512 CORE ADDRESS OF HEADER IN 33:15. JUST CHECK IT. 06460700
% >0, <512 VALUE FOR DIRECTORYSEARCH, FIND THE FILE AND PASS 06460800
% BACK THE HEADER IN ADDITION TO SECURITY INFO. 06460900
% <0 DISK ADDRESS OF HEADER. READ IT IN AND CHECK IT, BUT 06460950
% DONT PASS IT BACK. 06460960
% 06461100
% RESULT FROM SECURITYCHECK 06461200
% =0 NO LEGITIMATE USER FOUND 06461300
% =2 TERTIARY USER ( INPUT ONLY) 06461400
% =3 SECONDARY USER (INPUT/OUTPUT) 06461500
% =7 PRIMARY USER (INPUT/OUTPUT/LIB MAINT.) 06461600
BEGIN 06462000
REAL T2,DKSGROW,CODES,ROWS,ROW,DKADR,ROWSZ,C,USER,TYPE,SH; 06462100
REAL I=DKSGROW, FPBSIZE=CODES; 06462105
ARRAY FH[*],FPB=ROW[*]; 06462110
LABEL FOUND; 06462120
LABEL EXYT,NOTFOUND,LOOK,WHY,FORGET; 06462200
REAL SUBROUTINE DIRSRH; 06463000
BEGIN 06463100
LOOK: IF (T2:=DIRECTORYSEARCH(MID,FID,HEADER)) LSS 64 THEN 06463200
WHY: BEGIN 06463210
IF T2=0 THEN FILEMESS("#NO FIL","ON DISK",MID,FID,0,0,0) 06463220
ELSE IF T2=1 THEN BEGIN P(DEL); TYPE:=-1; GO EXYT; END 06463225
ELSE IF T2=2 THEN FILEMESS("#SYSFIL","ERROR ", 06463230
MID,FID,0,0,0); 06463240
IF AUTODS THEN TERMINATE(P1MIX&61[CTF]) ELSE %747-06463260
BEGIN %747-06463270
REPLY[P1MIX]:=-(SH:=VWY&VOK[36:42:6]&VIL[30:42:6]); 06463280
COMPLEXSLEEP((REPLY[P1MIX] GTR 0) OR TERMSET(P1MIX)); 06463300
END; 06463310
IF TERMSET(P1MIX) THEN GO INITIATE; 06463340
IF NOT WHYSLEEP(SH) THEN GO TO WHY; 06463360
IF (SH~T2~REPLY[P1MIX].[FF]) > PSEUDOMAXT THEN % IL%540-06463380
BEGIN STREAM(T2:); 06463400
BEGIN SI:=T2; 06463420
LL: SI:=SI+1; IF SC!"L" THEN GO TO LL; 06463440
SI:=SI+1; T2:=SI; 06463460
END; 06463480
T2:=P; 06463500
FPBSIZE:=(FPB:=PRT[P1MIX,3]).[8:10]; 06463520
FOR I:=0 STEP ETRLNG UNTIL FPBSIZE DO 06463540
IF (FPB[I] EQV MID)=NOT 0 THEN 06463560
IF (FPB[I+1] EQV ABS(FID))=NOT 0 THEN GO FOUND; 06463580
FOUND: NAMEID(C,T2); MID:=C; NAMEID(C,T2); 06463600
NAMEID(C,T2); FID:=C&FID[1:1:1]; 06463620
IF I LSS 1020 THEN 06463640
BEGIN FPB[I]:=MID; 06463660
FPB[I+1]:=C; 06463680
END; 06463700
FORGETSPACE(SH-1); 06463720
END ELSE LABELTABLE[T2]:=-(*P(DUP)); %764-06463740
REPLY[P1MIX]:=0; 06463760
GO TO LOOK; 06463780
END; 06463800
DIRSRH := T2; 06463810
END DIRSRH; 06463820
IF HEADER GEQ 0 THEN 06463840
SH:=IF HEADER GTR 511 THEN HEADER ELSE DIRSRH 06463860
ELSE DISKWAIT(-(SH:=SPACE(30)),30,HEADER.[CF]); 06463880
FH:=IOQUE&SH[CTC]; 06463900
IF(FH[2] EQV 0)=NOT 0 OR (ABS(USERID) EQV ABS(FH[2]))=NOT 0 06463910
OR (USERID EQV MCP)=NOT 0 THEN TYPE+7 ELSE% 06463920
IF HEADER<0 THEN GO EXYT ELSE 06463925
IF (FH[5] EQV @14)=NOT 0 THEN% 06463930
IF (FH[6] EQV @14)=NOT 0 THEN TYPE~2 ELSE TYPE~3;% 06463940
IF TYPE ~ 0 THEN GO TO EXYT; 06463950
IF FH[5].[1:1] THEN 06463960
BEGIN IF (SH:=DIRECTORYSEARCH(ABS(FH[5]),FH[6],19))=0 06463970
THEN BEGIN TYPE:=0; GO TO EXYT END; 06463980
M[SH+4].[11:1]:=1; 06463982
STREAM(DATE,J:=5); BEGIN SI:=LOC DATE; DS:=8OCT; END; 06463984
M[SH+3].[12:18]:=JUNK; 06463986
DISKWAIT(SH.[CF],-30,SH.[FF]); 06463988
$ SET OMIT = SHAREDISK 06463990
UNLOCKDIRECTORY; 06463992
$ POP OMIT 06463994
DKSGROW:=M[SH INX 8]; 06463996
CODES:=SPACE(30); 06464000
ROWS:=(M[SH INX 9] AND 31)-1; 06464050
FOR ROW:=0 STEP 1 UNTIL ROWS DO 06464100
BEGIN IF (DKADR:=M[SH INX 10+ROW])=0 THEN 06464200
NOTFOUND: BEGIN TYPE := 0; 06464300
FORGETSPACE(CODES); FORGETSPACE(SH);GO TO EXYT; 06464400
END; 06464500
ROWSZ := DKADR + DKSGROW; 06464600
WHILE DKADR < ROWSZ DO 06464700
BEGIN DISKIO(C,1-CODES,30,DKADR); 06464800
SLEEP([C],IOMASK); 06464900
FOR C:=0 STEP 1 UNTIL 29 DO 06465000
BEGIN IF((USER:=NFLAG(M[CODES INX C]))EQV @114= 06465100
NOT 0 THEN GO TO NOTFOUND; 06465200
IF (USER EQV @14)! NOT 0 THEN 06465210
IF USER.[3:3]=0 THEN 06465220
BEGIN 06465230
IF (USERID EQV ABS(USER))=NOT 0 THEN 06465300
BEGIN TYPE := 06465400
IF USER < 0 THEN 2 ELSE 3; 06465500
GO TO FORGET; 06465600
END; 06465700
END ELSE 06465800
BEGIN 06465805
IF P1MIX ! 0 THEN 06465810
IF (ABS)JAR[P1MIX,0])EQV 06465820
USER.[6:42])= NOT 0 THEN 06465830
IF((IF JAR[P1MIX,0]<0 THEN "DISK "ELSE JAR[P1MIX,1])EQV 06465840
M[CODES INX C+1].[6:42])= NOT 0 06465850
THEN 06465860
BEGIN 06465870
TYPE := USER.[3:3]; 06465880
GO TO FORGET; 06465900
END; C:=C+1; 06465910
END; 06465920
END; % 30 USERS 06466000
DKADR := DKADR + 1; 06466100
END; % ROW 06466200
END; % ROWS 06466300
GO TO NOTFOUND; 06466310
END; % NO SECURITY BLOCK FILE 06466400
TYPE :=0; 06466500
EXYT: 06466600
IF HEADER LSS 512 THEN 06466610
IF HEADER GEQ 0 THEN HEADER:=FH ELSE FORGETSPACE(FH); 06466620
SECURITYCHECK :=TYPE; 06466700
END SECURITYCHECK; 06467500
$ SET OMIT = NOT(DATACOM ) 06499999
% * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *%JS06845900
$ SET OMIT = NOT(DCLOG AND DATACOM ) 06845999
DEFINE KLULMP=@174#; @173 IS RESERVED FOR THE DISK ADDRESS 07000000
COMMENT LASTCDNUM, FIRSTDECK, AND LASTDECK ARE STORED IN THE 07000010
FIRST THREE WORDS OF THE DISK SEGMENT LOCATED AT DIRECTORYTOP 07000015
+3. IN A NON SHARED DISK SYSTEM, THEY ARE WRITTEN OUT EACH 07000020
TIME ONE OF THEM IS CHANGED SO THAT THEY WILL BE PRESERVED 07000025
IF A HALT/LOAD OCCURS. N A SHARED DISK SYSTEM, THEY ARE 07000030
READ INTO THE PRT WITH A READ-LOCK COMMAND EACH TIME THEY ARE 07000035
USED. THIS PROVIDES CONTROL DECK INTERLOCKING BETWEEN SYSTEMS 07000040
IN ADDITION TO PASSING THE INFORMATION BETWEEN SYSTEMS. 07000045
END COMMENT; 07000050
INTEGER LASTCDNUM=@174; 07000100
REAL FIRSTDECK=@175; 07000200
REAL LASTDECK=@176; 07000300
DEFINE LOCKCONTROLDECKS=BEGIN SLEEP([TOGLE],CDMASK); LOCKTOG(CDMASK); 07001000
$ SET OMIT = NOT(SHAREDISK) 07001099
END#, 07001200
UNLOCK(CONTROLDECKS=BEGIN 07001300
$ SET OMIT = NOT(SHAREDISK) 07001399
UNLOCKTOG(CDMASK) END#; 07001500
REAL PROCEDURE NEXTCDNUM(UPDATE); VALUE UPDATE; BOOLEAN UPDATE; 07001600
BEGIN 07001620
LOCKCONTROLDECKS; 07001640
LASTCDNUM := (LASTCDNUM MOD 9999) + 1; 07001660
STREAM(CDNUM:=0; LNUM:=LASTCDNUM); 07001680
BEGIN 07001700
SI:=LOC LNUM; DI:=LOC CDNUM; DS:=8 DEC; 07001720
END; 07001740
NEXTCDNUM := P; 07001760
IF UPDATE THEN 07001780
BEGIN 07001800
DISKWAIT(KLUMP,-3,DIRECTORYTOP+3); 07001820
UNLOCKTOG(CDMASK); 07001840
END; 07001860
END; 07001880
PROCEDURE STARTADECK(N); VALUE N; REAL N; FORWARD; 07002000
PROCEDURE ENTERCONTROLDECK(H); VALUE H; ARRAY H[*]; FORWARD; 07002100
REAL RUNNUMBER;% 07003000
%891-07003250
%#######################################################################07003251
%891-07003252
PROCEDURE EBTABLE; %890-07003270
BEGIN LABEL L; %890-07003280
P(0,XIT,.L,DEL); %890-07003290
L::: %890-07003300
0," 32?","1???","0TS?","/???","-LK?","J???","????","????","&CB?","A???",07003310
"!???","????","????","????","????",""????", %890-07003312
"9???","????","Z???","????","R???","????","????","????","I???","????", 07003320
"????","????","????","????","????","????", %890-07003322
"8#:?","????","Y,|?","????","Q$]?","????","????","????","H.[?","????", 07003330
"????","????","????","????","????","????", %890-07003332
@07770675,@05770413,@067146616,@65176473, %892-07003340
@47574656,@45554453,"????","????", @27742620,@25352436, %890-07003342
"????","????","????","????","????","????", %891-07003344
%QMARKADDRESSES %890-07003350
"????","????","????","????","????","????","????","????","????","????", 07003352
"????","????","????","????","????","????", %890-07003354
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, % SPACE FOR ADDRESSES %890-07003360
0,0,0,0,0,0,0; %890-07003370
END; %890-07003380
%891-07003390
%#######################################################################07003391
%891-07003392
PROCEDURE SETUPEBTABLE; %890-07003400
BEGIN REAL ADR; LABEL EXIT; %890-07003410
DEFINE STOREADDRESS= %890-07003412
X:=SI; SI:=LOC X; SI:=SI+5; %890-07003414
DS:=3 CHR; DI:=DI+5 #; %890-07003416
EBTABLE; %890-07003420
P([M[(ADR:=*P(.EBTABLE) INX NOT 1)]],IOR); %890-07003430
SETUPEBTABLE:=ADR:=ADR.[CF]+3; %890-07003440
IF M[ADR+81] = 0 THEN %890-07003450
STREAM (X:=0,TABLE:=ADR,QMARKTABLEADDRESS:=ADR+32,LOCATIONS:=ADR+40); 07003462
BEGIN %890-07003464
DI:=TABLE; SI:=TABLE; SI:=SI+8; %890-07003466
2(40(SI:=SI+4; DS:=4 CHR;)); %890-07003468
%FIRST FILL ALL OF ADDRESSES WITH ADDRESS OF ?S %890-07003482
SI:=QMARKTABLEADDRESS; %890-07003484
X:=SI; %890-07003486
SI:=LOC X; SI:=SI+5; %POINT SI AT ADDRESS OF QMARKS %890-07003488
DI:=LOCATIONS; %890-07003490
DS:=3 CHR; %890-07003492
SI:=LOCATIONS; %890-07003494
DS:=63 WDS; %890-07003496
%NOW SET ADDRESSES FOR VALID CHARS INTO EBCDIC TABLE %890-07003498
SI:=TABLE; %890-07003500
DI:=LOCATIONS; %890-07003502
3(STOREADDRESS; %STORE ADDRESSES FOR LP=0,1,2 %890-07003504
%CORRESPONDING TO BLANK,9 HOLE,8 HOLE %890-07003506
SI:=X; %890-07003508
SI:=SI+63; SI:=SI+1); %SKIP 8 WORDS DOWN TABLE %890-07003510
DI:=DI+8; %LP=3 IN INVALID %890-07003512
STOREADDRESS; %LP=4..... 7 HOLE %890-07003514
DI:=DI+8; %LP=5 IS INVALID %890-07003516
SI:=X; %890-07003518
SI:=SI+1; %SKIP 1 CHAR DOWN TABLE %890-07003520
STOREADDRESS; %LP=6....7&8 HOLES TOGETHER %890-07003522
DI:=DI+8; %890-07003524
SI:=X; %890-07003526
SI:=SI+1; %890-07003528
STOREADDRESS; %LP=8....6 HOLE %890-07003530
DI:=DI+8; %890-07003532
SI:=X; %890-07003534
SI:=SI+1; %890-07003536
STOREADDRESS; %LP=10....6&8 HOLES TOGETHER %890-07003538
SI:=DI+40; %MISS 5 WORDS...LP=11,12,13,14,15 %890-07003540
SI:=X; %890-07003542
SI:=SI+1; %890-07003544
STOREADDRESS; %LP:=16.... 5 HOLE %890-07003546
DI:=DI+8; %890-07003548
SI:=X; %890-07003550
SI:=SI+1; %890-07003552
STOREADDRESS; %LP=18.... 5&8 HOLES TOGETHER %890-07003554
2(DI:=DI+52); %MISS 13 WORDS....LP=19-31 %890-07003556
SI:=X; %890-07003558
SI:=SI+1; %890-07003560
STOREADDRESS; %LP=32..... 4 HOLE %890-07003562
DI:=DI+8; %890-07003564
SI:=X; %890-07003566
SI:=SI+1; %890-07003568
STOREADDRESS; %LP=34...... 4&8 HOLES TOGETHER %890-07003570
END; %890-07003580
END; %890-07003590
%***********************************************************************07003600
STREAM PROCEDURE EBCDICCONVERT(INTO,TABLE,POINTERS); %890-07003610
VALUE INTO,TABLE,POINTERS; %890-07003615
%***********************************************************************07003620
BEGIN %890-07003630
LOCAL HP,LP,SRCE,DEST,HPPTR,LPPTR; %890-07003640
%POINT HPPTR & LPPTR TO LAST CHAR OF HP,LP %890-07003650
SI:=LOC HP; %890-07003660
SI:=SI+7; %890-07003670
HPPTR:=SI; %HIGH PART %890-07003680
SI:=LOC LP; %890-07003690
SI:=SI+7; %890-07003700
LPPTR:=SI; %LOW PART %890-07003710
SI:=INTO; SI:=SI+8; %890-07003720
DI:=INTO; %890-07003730
%START CHARACTER TRANSLATE LOOP %890-07003740
2(40( %890-07003750
DEST:=DI; %890-07003760
%TRANSFER LOW & HIGH PARTS %890-07003770
DI:=HPPTR; %890-07003780
DS:=1 CHR; %890-07003790
DI:=LPPTR; %890-07003800
DS:=1 CHR; %890-07003810
SRCE:=SI; %STORE SI FOR NEXT PASS THRU LOOP %890-07003820
%NOW FIND THE POINTER INTO TABLE APPROPRIATE TO LP %890-07003830
SI:=POINTERS; %890-07003840
LP(SI:=SI+8); %890-07003860
SI:=SC; %SI NOW POINTS INTO TABLE @ POINT DEPENDANT ON LP %890-07003870
DI:=DEST; %890-07003880
SI:=SI+HP; %SKIP SI THROUGH TABLE HP CHARS %890-07003890
DS:=CHR; %890-07003900
SI:=SRCE)); %890-07003910
DI:=TABLE; DI:=DI+3; %POINT TO QMRK %890-07003920
END CONVERT; %890-07003950
PROCEDURE COM23;% 07004000
BEGIN% 07005000
REAL INBUFF,% ADDRESS OF THE INPUT BUFFER. 07006000
OUTBUFF,% " " " OUTPUT BUFFER. 07006010
FIRSTCARD,% " " " CARD IMAGE OF THE FIRST CARD 07006020
OUTBUFFOLD,% " " " LAST OUTPUT BUFFER. 07006030
RESERVE,% " " 30 WDS OF CORE USED TO BUILD THE 07006040
T,T1,T2,% TEMPORARY VARIABLES. 07006050
R,L,N,% " " USED TO COUNT CARD IMAG 07006060
Q,% USUALLY INDICATES COL 1 HAS A QUESTION MARK 07006070
IU,% UNIT NUMBER OF THE INPUT UNIT. 07006080
OU,% " " " " OUTPUT UNIT. 07006090
FIRST,% TRUE IF THE FIRST CARD OF A DECK. 07006100
S,% USED AS A TEMPROARY VARIABLE IN SUBROUTINE 07006140
% AND TO HAND THE UNIT NUMBER TO SUBROUTINE S 07006150
D;% USED AS A MASK TO SLEEP UNTIL DISK OPERATIO 07006160
% ARE COMPLETED. 07006161
$ SET OMIT = NOT(PACKETS) 07006169
REAL VERYFIRST, %TRUE IF THE FIRST CARD OF THE FIRST DECK 07006172
%IN SINCE LOAD CONTROL WAS EXECUTED. 07006174
FIRSTORSEC, %TRUE IF THE FIRST OR SEC. CARD OF NEW DECK 07006176
PTYPE,% CONTAINS THE RESULT OF REAL SUBROUTINE 07006180
% PACKETCARD.SAVING SOME NEEDLESS EXTRA 07006190
% CALLS ON IT TO CHECK THE TYPE OF A CARD. 07006200
% THE VALUE OF PTYPE IS AS FOLLOWS: 07006210
% 0 = NOT A PACKET CONTROL CARD 07006220
% 1 = "PACKEND"CARD, (USED BY THE 07006230
% OPERATORS TO END A GROUP 07006240
% OF PACKETS BEING LOADED TO 07006250
% DISK) 07006260
% 3 = "PACKET" CARD,(FIRST CARD 07006270
% OF A PACKET) 07006280
% 5 = "END PACKETS" CARD, (USED BY 07006290
% THE OPERATORS TO BOTH END 07006300
% A GROUP OF PACKETS AND 07006310
% SIMULTANEOUSLY DISCONTINUE 07006320
% LOAD CONTROL). 07006330
PLUGGED;% TRUE IF THE LAST "PACKET" CARD(I.E., 07006340
% PTYPE=3), WAS BOTH THE START OF A NEW 07006350
% PACKET AND WAS USED TO "PLUG" THE END 07006360
% OF THE LAST PACKET WITH AN ARTIFICIAL 07006370
% "-QUESTION MARK- PACKET." CARD; 07007000
$ POP OMIT 07007001
BOOLEAN CDONLY; 07007100
INTEGER A,I;% 07008000
$ SET OMIT = NOT(PACKETS) 07008199
REAL CONTINUE,DISKCHAIN,ADECK; LABEL OK; 07008200
$ POP OMIT 07008251
LABEL AGAIN,INL,ERROR,SUPER,BOMB,SKIPIT,EXIT; 07009000
LABEL INPUTL; 07009100
BOOLEAN EBCDIC; REAL EBTABLEADR; %890-07009200
ARRAY FPB[*],H[*];% 07010000
SUBROUTINE STOP;% 07011000
BEGIN IF S ! 18 THEN% 07012000
BEGIN READY ~ NOT(Q ~ TWO(S)) AND READY;% 07013000
RRRMECH ~ NOT Q AND RRRMECH OR Q AND SAVEWORD;% 07014000
LABELTABLE[S] ~ @114;% 07015000
RDCTABLE[S] ~ MULTITABLE[S] ~ 0% 07016000
END;% 07017000
FPB[T+1]~ *P(DUP)+CLOCK+P(RTR);% 07018000
FPB[T].[24:12] ~ TINU[S].[18:12];% 07019000
TINU[S].[18:12]:=0; 07020000
END;% 07021000
$ SET OMIT = PACKETS 07021999
$ SET OMIT = NOT(PACKETS) 07022099
SUBROUTINE FORGETONE; 07022100
$ POP OMIT 07022101
BEGIN T1 ~ H[9]+9;% 07023000
FOR T2 ~ 10 STEP 1 UNTIL T1 DO% 07024000
FORGETUSERDISK(H[T2],-H[8]); 07025000
END;% 07026000
$ SET OMIT = NOT(PACKETS) 07026099
SUBROUTINE FORGETIT; 07026100
BEGIN FORGETONE; 07026200
WHILE DISKCHAIN NEQ 0 DO 07026300
BEGIN DISKWAIT(-(H INX 0),30,DISKCHAIN); 07026400
DISKCHAIN:=H[6].[FF]; 07026500
FORGETONE; 07026600
END; 07026700
END FORGETIT; 07026800
$ POP OMIT 07026801
SUBROUTINE BOMBTIME;% 07027000
BEGIN WHILE STOPSET(P1MIX) DO STOPM(FALSE); 07028000
IF TERMSET(P1MIX) THEN GO BOMB; END; 07028100
$ SET OMIT = NOT(PACKETS) 07028999
REAL SUBROUTINE PACKETCARD;% THIS USED TO BE "ENDCARD" 07029000
BEGIN IF Q THEN% 07030000
BEGIN;% 07031000
IF EBCDIC THEN %890-07031200
BEGIN %890-07031300
EBCDIC:=FALSE; %890-07031400
M[(*P(.EBTABLE) INX NOT 1)].[2:1]:=0; %890-07031500
END; %890-07031600
STREAM(X:="PACKETS":Y:="CONTINU",Z:="END. ", %890-07032000
EB:="DATA029",INBUFF); %890-07032100
BEGIN SI ~ INBUFF;% 07033000
L: SI ~ SI+1; IF SC = " " THEN GO TO L;% 07034000
INBUFF:=SI; %890-07034500
DI~LOC X; DI~DI+1;% POINT TO "PACKETS" 07035000
IF 4SC=DC THEN% A "PACKET" OR "PACKEND" CARD 07036000
IF 2SC=DC THEN TALLY~3% A "PACKET" CARD 07036100
ELSE TALLY~1% A "PACKEND" CARD 07036150
ELSE BEGIN DI~DI-4;% POINT TO "PACKETS" 07036200
IF 7 SC=DC THEN TALLY:=5 %"END PACKET" 07036210
ELSE BEGIN SI:=INBUFF;DI:=LOC Y; %890-07036220
DI:=DI+1;IF 7SC=DC THEN TALLY:=6 07036230
ELSE BEGIN DI:=LOC Z;DI:=DI+1; 07036240
SI:=INBUFF; %890-07036250
IF 3 SC=DC THEN TALLY:=7 %890-07036260
ELSE BEGIN %890-07036270
DI:=LOC EB;DI:=DI+1 %890-07036280
SI:=INBUFF; 07036290
IF 6 SC=DC THEN %890-07036300
$VOID %890-07036310
TALLY:=4; 07036320
$ VOID 07036351 %890-07036330
END END END; %890-07036390
END;% 07036400
X ~ TALLY;% 07037000
END;% 07038000
END ELSE P(0);% 07039000
PTYPE:=P; 07039100
IF PTYPE=6 THEN BEGIN PTYPE:=3; CONTINUE:=TRUE END 07039200
ELSE CONTINUE:=FALSE; 07039300
IF PTYPE=7 THEN PTYPE:=ADECK; 07039410
IF PTYPE = 4 THEN %890-07039500
BEGIN PTYPE:=0; EBCDIC:=TRUE; %890-07039600
EBTABLEADR:=SETUPEBTABLE; %890-07039700
END; %890-07039800
PACKETCARD:=PTYPE; 07040000
END;% 07041000
$ POP OMIT 07041001
$ SET OMIT = PACKETS 07041099
REAL SUBROUTINE ADR;% 07042000
BEGIN IF (T2 ~ H[(T1 ~ R DIV 200)+10]) = 0 THEN% 07043000
BEGIN H[9] ~ T1+1;% 07044000
H[T1+10] ~ T2 ~ GETUSERDISK(200);% 07045000
END;% 07046000
ADR ~ R MOD 200+T2% 07047000
END;% 07048000
SUBROUTINE INPUT;% 07049000
BEGIN% 07050000
IF IU < 16 THEN% 07051000
$ SET OMIT = NOT(PACKETS) 07051099
BEGIN 07051100
INPUTL: T ! WAITIO (@120540000000 + INBUFF, 07051110
@6000040, IU); 07051120
IF T=@40 THEN GO TO INPUTL; 07051130
IF T!0 THEN 07051140
BEGIN 07051150
P(DEL); 07051160
GO TO ERROR 07051170
END; 07051180
$ POP OMIT 07051181
$ SET OMIT = PACKETS 07051999
Q ~ M[INBUFF-1]=9;% 07057000
END% 07058000
ELSE BEGIN WHILE(Q:=WAITIO(@40000000+INBUFF+ %890-07059000
EBCDIC|@400000001,FIRST|4+ %890-07059010
@4000000,IU).[45:1] DO 07059100
IF FIRST AND CDONLY AND NOT CONTINUE THEN %654-07059110
GO EXIT ELSE %654-07059112
BEGIN SLEEP([TOGLE],STATUSMASK); 07059200
RRRMECH~RRRMECH AND NOT Q~TWO(IU); 07059300
READY~READY AND NOT Q; 07059400
SLEEP([READY],Q); 07059500
END; 07060000
IF EBCDIC THEN EBCDICCONVERT(INBUFF, %890-07060100
EBTABLEADR,EBTABLEADR+40) ELSE %890-07060200
IF Q ~ Q ! 0 THEN 07061000
BEGIN S:=(T:=UNIT[IU]).[FF]; 07062000
RETURNIOSPACE(S); 07063000
UNIT[IU] ~ T&@77777[5:20:28]; 07065000
END;% 07066000
STREAM(QMK:=12:BCL:=1-EBCDIC,INBUFF); %890-07066100
BEGIN %890-07066200
SI:=INBUFF; %890-07066300
BCL (IF SC=""" THEN JUMP OUT TO L1); 07066350
IF SC=@14 THEN %890-07066400
L1: BEGIN SI:=LOC QMK;SI:=SI+7; %890-07066500
DS:=1 CHR; %890-07066550
TALLY:=1; %890-07066600
SI:=INBUFF; %890-07066610
2(36(IF SC=">" THEN %890-07066620
BEGIN INBUFF:=SI; DI:=INBUFF; %890-07066630
DS:=LIT "="; %890-07066635
END; %890-07066640
IF SC="}" THEN %890-07066650
BEGIN INBUFF:=SI; DI:=INBUFF; %890-07066660
DS:= LIT """ %890-07066665
END; SI:=SI+1;)) %890-07066670
END; %890-07066700
QMK :=TALLY; %890-07066800
END; %890-07066850
Q:=P OR Q; %890-07066900
T = 0;% 07067000
END;% 07068000
END INPUT; % -07069000
%---------------- COM23 ------------------- -07069200
$ SET UP INPUT VARIABLES% 07071000
IF CDONLY:=(PRT[P1MIX,@25]>22) THEN 07072000
BEGIN IU:=PRT[P1MIX,@25]; 07072100
PRT[P1MIX,@25]:=0; % DISK 07072200
END ELSE 07072300
BEGIN IF (IU:=FINDINPUT("CONTROL","DECK ",0,0,0,0,0,0, 07072400
0,0)) LSS 0 THEN GO INITIATE; % BEEN DS-ED 07072500
IF IU GEQ 32 THEN P(XIT); % EOJ IF PSEUDODCK07072600
END; 07072700
STARTIMING(0,IU); 07073000
FPB:=PRT[P1MIX,3]; 07073500
$ SET OMIT = PACKETS 07073999
IF NOT(JAR[P1MIX,9].[2:1]) THEN % DONT SUPPRESS MESSAGE 07074090
FILEMESSAGE(" IN "&TINU[IU][6:30:18],0, 07074100
"CONTROL","DECK ",0,0,0,OPNMESS); 07074200
RDCTABLE[IU].[8:6] ~ P1MIX;% 07075000
IF IU LSS 16 THEN BEGIN% 07076000
FPB[3].[23:1]:=1; %SET INPUT FLAG FOR LOG 07076010
T ~ WAITIO(@540000005,0,IU)% 07077000
END% 07077010
ELSE IF IU=23 AND READERA NEQ 0 THEN 07078000
BEGIN FORGETSPACE(READERA-2);% 07079000
READERA ~ 0;% 07080000
END% 07081000
ELSE IF IU=24 AND READERB NEQ 0 THEN 07082000
BEGIN FORGETSPACE(READERB-2);% 07083000
READERB ~ 0;% 07084000
END;% 07085000
$ VOIDT %890-07086000
FIRSTCARD ~ GETSPACE(10,CONTROLCARDAREAV,1)_2);% %167-07087000
% SET UP OUTPUT VARIABLES% 07088000
IF PRT[P1MIX,@25] THEN% 07089000
BEGIN OU ~ LABELASCRATCH(T ~% 07090000
TAPELABEL("CONTROL","DECK ",1,1,100));% 07091000
IF OU<0 THEN GO INITIATE; %BEEN DS-ED 07091100
FORGETSPACE(I);% 07093000
FPB[3].[23:1]:=0; %SET OUTPUT FLAG FOR LOG 07093010
END% 07094000
ELSE BEGIN OUTBUFFOLD ~ OUTBUFF ~% %167-07095000
GETSPACE(60,IOBUFERAREAV,1)+2;% %167-07095100
RESERVE ~ GETSPACE(30,0,1)+2;% 07096000
H := SAVEARRAYDESC(30,DISKHEADERAREAV); %167-07097000
OU ~ 18;% 07098000
INBUFF ~ GETSPACE(21,IOBUFFERAREAV,1) + 2; %892-07101000
END;% 07103000
STARTIMING(5,OU); 07104000
FPB:=PRT[P1MIX,3]; % STARTIMING MAY HAVE MOVED IT. 07104500
$ SET OMIT = NOT(PACKETS) 07105499
VERYFIRST~1;% 07105500
$ POP OMIT 07105501
% BEGIN ONE DECK% 07106000
AGAIN: OUTBUF ~ OUTBUFFOLD;% 07107000
L ~ N ~ 0;% 07108000
$ SET OMIT = NOT(PACKETS) 07108099
ADECK ~ 0; FIRSTORSEC ~ %178-07108100
$ POP OMIT 07108101
FIRST ~ D ~ 1; 07109000
IF OU = 18 THEN% 07110000
BEGIN H[ 9] ~ 0;% 07111000
MOVE(20,[H[9]],[H[10]]); 07112000
H[8]~200; 07112100
END;% 07113000
% BEGIN ONE CARD% 07114000
INL: 07115000
$ SET OMIT = NOT(PACKETS) 07115099
IF PTYPE NEQ 3 OR VERYFIRST THEN 07115100
$ POP OMIT 07115101
INPUT; 07115200
$ SET OMIT = NOT(PACKETS) 07115499
IF FIRSTORSEC THEN% 07115500
$ POP OMIT 07115501
IF FIRST THEN% 07116000
BEGIN 07117000
$ SET OMIT = NOT(PACKETS) 07117099
PLUGGED:=VERYFIRST; 07117100
$ POP OMIT 07117101
$ SET OMIT = PACKETS 07117199
MOVE(10,INBUFF,FIRSTCARD);% 07118000
$ SET OMIT = NOT(PACKETS) 07118099
IF PACKETCARD=5 THEN %124-07118500
IF OU<16 THEN FIRST:=VERYFIRST:=0 ELSE 07118510
GO TO EXIT ELSE 07118520
IF PTYPE!3 OR CONTINUE THEN 07118550
BEGIN 07118600
ADECK:=1; GO DK; 07118690
END; 07118700
END ELSE% THIS MUST BE THE SECOND CARD IN 07119000
$ POP OMIT 07119001
$ SET OMIT = PACKETS 07119009
$ SET OMIT = NOT(PACKETS) 07119099
DK: IF Q THEN FIRSTORSEC:=0 ELSE%BAD SEC./FIRST 07119100
BEGIN VERYFIRST+4; % CARD 07119200
GO TO ERROR;% 07119300
END;% INV DECK SET-UP 07119400
$ POP OMIT 07119401
IF T NEQ 0 THEN 07120000
$ SET OMIT = NOT(PACKETS) 07120009
IF PTYPE NEQ 3 OR VERYFIRST THEN 07120010
$ POP OMIT 07120011
GO TO ERROR; 07120020
BOMBTIME;% 07121000
IF OU < 16 THEN % OUTPUT TO TAPE ( OU = 18 NORMALLY) -07122000
BEGIN 07122010
$ SET OMIT = NOT(PACKETS) 07122999
PLUGGED ~ VERYFIRST OR (PACKETCARD!3) 07123500
OR FIRST; 07124000
IF PLUGGED THEN 07124500
$ POP OMIT 07124501
T~WAITIO(INBUFF&@5000[18:33:15] 07125000
&(10-Q)[8:38:10],0,OU); 07125500
$ SET OMIT = PACKETS 07125599
$ SET OMIT = NOT(PACKETS) 07125999
IF VERYFIRST THEN VERYFIRST~PTYPE~0; 07126000
IF FIRST THEN FIRST~PTYPE~0; 07126500
IF PTYPE=0 THEN GO TO INL; 07127000
$ POP OMIT 07127001
M[INBUFF-1] ~ @1737000000000000; 07127500
T ~ WAITIO(INBUFF-1,0,OU); 07128000
SUPER:: 07129000
$ SET OMIT = NOT(PACKETS) 07129099
IF PTYPE=5 THEN GO TO EXIT; 07129100
IF PTYPE=1 THEN VERYFIRST:=TRUE; 07129200
GO TO AGAIN; 07129300
$ POP OMIT 07129301
$ SET OMIT = PACKETS 07129999
END;% 07139000
IF D = 0 THEN SLEEP([D],NOT 0); 07139500
$ SET OMIT = NOT(PACKETS) 07139509
IF PACKETCARD NEQ 0 AND NOT(ADECK AND PTYPE=1) THEN 07139510
BEGIN IF NOT(PLUGGED OR FIRST) THEN% 07139511
BEGIN STREAM(D~OUTBUFF); BEGIN DS~27 LIT 07139512
"CC END...IN CASE YOUR FORGOT";DS~45LIT" " END; 07139513
IF PTYPE = 3 AND NOT CONTINUE AND NOT ADECK THEN %124-07139520
BEGIN STREAM(FIRSTCARD,T!T!SPACE(13)); 07139530
BEGIN DS~24LIT"#NO PACKEND CARD, PKT - "; SI~FIRSTCARD; 07139540
DS!9 WDS; DS~LIT"~"; 07139550
END; 07139560
SPOUT(T); 07139565
END; 07139570
END ELSE MOVE(10,INBUFF,OUTBUFF);% 07139575
END ELSE% 07139590
$ POP OMIT 07139591
MOVE(10,INBUFF,OUTBUFF);% 07140000
$ SET OMIT = NOT(PACKETS) 07140099
IF VERYFIRST THEN PLUGGED~0;% 07140100
$ POP OMIT 07140101
IF Q THEN% 07141000
BEGIN IF L DIV 6 ! N DIV 6 THEN% 07142000
BEGIN R ~ L DIV 3;% 07143000
A ~ ADR;% 07144000
DISKIO(T,1-RESERVE,30,A);% 07145000
SLEEP([T],IOMASK);% 07146000
M[I~L MOD 3|10+9+RESERVE] ~ N;% 07147000
DISKIO(T,RESERVE-1,30,A);% 07148000
SLEEP([T],IOMASK);% 07149000
END% 07150000
ELSE M[I ~(L-N)|10+9+OUTBUFF] ~ N;% 07151000
L ~ M[OUTBUFF+9] ~ N;% 07152000
END;% 07153000
IF N = 12000 THEN% 07154000
BEGIN I ~ SPACE(14);% 07155000
STREAM(FIRSTCARD,T); 07156000
BEGIN DS ~ 32 LIT% 07157000
$ SET OMIT = NOT(PACKETS) 07157099
"#MORE THAN 12000 CARDS IN PKT - "; 07157100
$ POP OMIT 07157101
$ SET OMIT = PACKETS 07157999
SI~FIRSTCARD;DS~9WDS;DS~LIT "~"; 07159000
END;% 07160000
GO TO SKIPIT; 07161000
END;% 07162000
IF (N ~ N+1) MOD 6 = 0 THEN% 07163000
BEGIN R ~ N DIV 3-2;% 07164000
A ~ ADR;% 07165000
OUTBUFF ~ OUTBUFFOLD;% 07166000
DISKIO(D,OUTBUFF-1,60,A); 07167000
END ELSE OUTBUFF ~ OUTBUFF+10;% 07169000
$ SET OMIT = NOT(PACKETS) 07169099
IF FIRST THEN FIRST~PTYPE~0;% 07169100
IF VERYFIRST THEN VERYFIRST:=PTYPE:=0; 07169110
$ POP OMIT 07169201
$ SET OMIT = NOT(PACKETS) 07169499
IF PTYPE=0 THEN GO INL; 07169500
$ POP OMIT 07169501
$ SET OMIT = PACKETS 07169999
IF D = 0 THEN SLEEP([D],NOT 0); 07171000
OUTBUFF ~ OUTBUFFOLD;% 07173000
R ~ N DIV 6|2;% 07174000
A ~ ADR;% 07175000
IF N MOD 6 ! 0 THEN 07175100
BEGIN 07175200
DISKIO(T,OUTBUFF-1,60,A);% 07176000
SLEEP([T],IOMASK);% 07177000
END;% 07178000
IF R+2 < 200 THEN 07178100
BEGIN H[8] ~ R+2; 07178200
FORGETUSERDISK(A+2,R-198); 07178300
END; 07178400
H[7]~N-1; 07179000
H[4]~H[6]~0; 07179050
H[5]:= -0; 07179100
$ SET OMIT = NOT(PACKETS) 07179199
H[6]~0&DISKCHAIN[CTF]&(IF IU<23 THEN 2 ELSE IU-23) 07179200
[2:42:6]; 07179202
IF CONTINUE THEN 07179205
BEGIN 07179210
H[2]:=NEXTCDNUM(1); 07179220
DISKCHAIN:=GETESPDISK; 07179230
DISKWAIT(H INX 0,30,DISKCHAIN); 07179250
STREAM(A:=H[2],B:=FIRSTCARD,INBUFF); 07179260
BEGIN SI:=B; DS:=8 CHR;DS:=15 LIT" CONTINUES PKT#"; 07179270
DS:=15 LIT" CONTINUES PKT#"; 07179280
SI:=LOC A; SI:=SI+4; DS:=4 CHR; DS:=LIT":"; 07179290
END; 07179300
END ELSE 07179310
BEGIN DISKCHAIN:=0; 07179320
$ POP OMIT 07179321
ENTERCONTROLDECK(H); 07180000
$ SET OMIT = NOT(PACKETS) 07180009
END; 07180010
$ POP OMIT 07180011
GO TO SUPER; 07181000
ERROR: T ~ SPACE(12);% 07214000
$ SET OMIT = NOT(PACKETS) 07214099
STREAM(FIRSTCARD,X~VERYFIRST,T);% 07214100
BEGIN SI~LOC X; SI~SI+7; IF SC="2" THEN 07214110
DS~16 LIT "#INV PKT CARD - "% 07214120
ELSE IF SC="4" THEN% 07214130
DS~16 LIT "#INV DECK,PKT - "% 07214140
ELSE DS~16 LIT "#READ ERR,PKT - ";% 07214150
$ POP OMIT 07214151
$ SET OMIT = PACKETS 07214999
SI ~ FIRSTCARD; DS ~ 9 WDS; DS ~ LIT "~";% 07217000
END;% 07218000
SKIPIT: SPOUT(T); 07219000
DO BEGIN INPUT;% 07220000
VOMVRIMW;% 07221000
$ SET OMIT = PACKETS 07221999
$ SET OMIT = NOT(PACKETS) 07222099
END UNTIL PACKETCARD NEQ 0; 07222100
$ POP OMIT 07222101
IF OU < 16 THEN% 07223000
BEGIN DO BEGIN T ~ WAITIO(@340000005,@60,OU);% 07224000
BOMBTIME;% 07225000
END UNTIL T.[42:1];% 07226000
T ~ WAITIO(@140000005,@60,OU);% 07227000
END;% 07228000
ELSE FORGETIT;% 07229000
GO TO SUPER;% 07230000
BOMB:: IF OU=18 THEN FORGETIT;% %164-07231000
EXIT: SLEEP([TOGLE]),STATUSMASK); 07232000
IF IU GEQ 23 THEN UNITCODE[IU-23]:=-0; 07232500
S ~ IU; T ~ 3; STOP;% 07233000
S ~ OU; T ~ 8; STOP;% 07234000
FORGETSPACE(INBUFF);% 07235000
FORGETSPACE(FIRSTCARD);% 07236000
IF OU > 16 THEN% 07237000
BEGIN FORGETSPACE(H);% 07238000
FORGETSPACE(OUTBUFFOLD);% 07239000
FORGETSPACE(RESERVE);% 07240000
END;% 07241000
END COM23;% 07242000
PROCEDURE STARTLOADN(KTR); VALUE KTR; REAL KTR;% 07243000
BEGIN REAL HDR,SEG0,I,F,T,C; ARRAY SHEAT[*]; 07244000
LABEL TRYAGAIN,LDCNTRL,DISK; 07244100
STREAM(K~0:KTR);% 07245000
BEGIN SI ~ KTR;% 07246000
L: IF SC = " " THEN% 07247000
BEGIN SI ~ SI+1; GO TO L END;% 07248000
DI ~ LOC K; DI ~ DI+6; DS ~ 2 CHR;% 07249000
END;% 07250000
C ~ P;% 07251000
T ~ KTR.[15:15]-1;% 07252000
IF (C NEQ "MT" AND C NEQ "DK") OR 07253000
(C = "DK" AND CDONLY ) THEN 07253100
SPOUT(T INX M[T-1]) 07254000
ELSE BEGIN C ~ C = "MT";% 07255000
TRYAGAIN: 07255100
IF (HDR:=DIRECTORYSEARCH(P(LDCNTRL),P(DISK),3)) ! 0 THEN 07256000
BEGIN 07256200
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV)]] & 30[8:38:10];%07256400
STREAM(S:=F-1, D:=F); % ZERO OUT THE SHEAT ENTRY 07256600
BEGIN 07256800
SI:=S; DS:=30 WDS; 07257000
END; 07257200
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-07257400
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 07257600
F.[FF] := HDR; % CORE ADDRESS OF HEADER IN [FF] OF PARAM. 07257800
SHEAT[7] := SEG0; % CORE ADRS.OF SEGMENT ZERO IN SHEAT[7]07258000
SHEAT[0] := P(LDCNTRL); 07258200
SHEAT[1] := P(DISK); 07258400
SHEAT[2] := 0 & LDCNTRLCODE[5:45:3] & 2[8:38:10]; 07258600
% [4:1] IN SHEET[2] MEANS SUPRESS BOJ/EOJ MESSAGES 07258800
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS 07259000
SHEAT[19] := C; % COMMON VALUE 07259200
SHEAT[20] := 4; % CORE ESTIMATE 07259400
SHEAT[21] := 150; % STACK SIZE 07259600
07259800
STREAM(A:=0 : S := P(.SCHEDULEIDS)); 07260000
BEGIN 07260200
SI:=S; 07260400
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 07260600
IF SB THEN ELSE JUMP OUT); 07260800
DS:=SET; A:=TALLY; 07261000
END STREAM STATEMENT; 07261200
07261400
I := P; 07261600
SHEAT[3].[8:10] := 1; % SCHEDULE NUMBER 07261800
SHEAT[23] := (CLOCK + P(RTR)) DIV 60; 07262000
SHEAT[24] := MCP; %131-07262100
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 07262200
STREAM(C, T); 07262400
BEGIN 07262600
DI:=DI+16; 07262800
DS:=31LIT"CC EXECUTE LDCNTRL/DISK;COMMON="; 07263000
SI:=LOC C; DS:=8DEC; 07263200
DS:=6LIT";END.~"; 07263400
END STREAM STATEMENT; 07263600
M[T] := 0; M[T+1] := 10; 07263700
SHEAT[6] := GETESPDISK & 10[18:33:15]; 07263800
DISKWAIT(T, 11, SHEAT[6].[CF]); 07264000
FORGETSPACE(T); 07264200
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 07264400
END ELSE % IF IN DIRECTORY 07265000
BEGIN 07265100
ENTERSYSFILE(2); 07265200
GO TRYAGAIN; 07265300
LDCNTRL::: "LDCNTRL"; 07265400
DISK::: "DISK "; 07265500
END; 07265600
END;% 07266000
END;% 07267000
PROCEDURE TABLEOFCONTENTS(B,COUNT);% 07268000
VALUE B,COUNT; REAL B,COUNT;% 07268100
BEGIN REAL I,T,NA,TUSTA,TU,BU; 07269000
$ SET OMIT = NOT(PACKETS) 07269099
REAL FIRST,START,FINAL,PKTCT;% 07269100
$ POP OMIT 07269101
LABEL L,EXIT,G;% 07270000
$ SET OMIT = NOT(SHAREDISK) 07270099
A:=B.[15:15]-1; 07271900
TUSTA:=M[A-1]; 07272000
LOCKCONTROLDECKS; 07272500
A:=FIRSTDECK; 07273000
$ SET OMIT = NOT(PACKETS) 07273099
FIRST~1;% 07273100
$ POP OMIT 07273101
L: I:=SPACE(14) INX TUSTA; 07274000
G: IF A = 0 THEN GO TO EXIT;% 07275000
DISKWAIT(-1,12,A); 07276000
A:=M[I+6].[CF]; 07278000
$ SET OMIT = NOT(DATACOM AND RJE ) 07278499
$ SET OMIT = NOT(SHAREDISK) 07279000
N ~ M[I+2];% 07281000
$ SET OMIT = NOT(PACKETS) 07281099
IF NOT COUNT THEN% 07281100
BEGIN% 07281200
$ POP OMIT 07281201
DISKWAIT(-I-4,9,M[I+10]); 07282000
STREAM(N,T,TU,BU,I); 07284000
BEGIN SI ~ LOC N; SI ~ SI+1;% 07285000
$ SET OMIT = NOT(PACKETS) 07285099
DS:=8 LIT " PACKET ";DS:=5 CHR; 07285100
$ POP OMIT 07285111
$ SET OMIT = PACKETS 07285999
$ SET OMIT = NOT(SHAREDISK) 07286100
$ SET OMIT = SHAREDISK 07286400
DS:=8 LIT" "; 07286500
$ POP OMIT 07286501
$ SET OMIT = NOT(PACKETS) 07286509
DS:=3 LIT " ="; 07286510
$ POP OMIT 07286511
$ SET OMIT = NOT(RJE AND DATACOM ) 07286599
DS:=8 LIT " "; 07286800
NEX: 07286900
$ SET OMIT = PACKETS 07286999
$ SET OMIT = NOT(PACKETS) 07288099
DI:=DI+40;DI:=DI+19;DS:=LIT"~"; 07288100
$ POP OMIT 07288101
END;% 07289000
SPOUT(I);% 07290000
$ SET OMIT = NOT(PACKETS) 07290099
END ELSE% 07290100
BEGIN% OPERATOR WANTS A COUNT 07290200
IF FIRST THEN BEGIN% STORE FIRST DECK #. 07290300
FIRST~0; START~N;% 07290400
END;% 07290500
PKTCT~PKTCT+1; FINAL~N;% 07290600
FORGETSPACE(I);% 07290650
END;% 07290700
$ POP OMIT 07290701
GO TO L;% 07291000
EXIT:IF N=0 THEN 07292000
BEGIN STREAM(I); 07293000
$ SET OMIT = NOT(PACKETS) 07293099
DS:=20 LIT " NO PACKETS ON DISK~"; 07293100
$ POP OMIT 07293101
$ SET OMIT = PACKETS 07293199
SPOUT(I);% 07294000
$ SET OMIT = PACKETS 07294899
$ SET OMIT = NOT(PACKETS) 07294999
END ELSE% CHECK FOR COUNT REQUEST. 07295000
IF COUNT THEN% 07295010
BEGIN;STREAM(C~PKTCT,S~START,% 07295020
F~FINAL,T1~0,T2~0,I);% 07295030
BEGIN DS~LIT " "; T2~DI;% 07295040
SI~LOC C; DI~LOC T1;% 07295050
DS~2 DEC; SI~LOC T1; DI~T2; 07295060
DS~2 CHR; T2~DI; DI~DI-2;% 07295070
DS~FILL; DI~T2;% 07295080
DS~7 LIT " PACKET";% 07295090
SI~LOC T1; %511-07295100
IF SC!"0" THEN GO TO AQ %511-07295102
ELSE SI~SI+I; %511-07295104
IF SC="1" THEN% ONLY 1 DECK %511-07295110
BEGIN DS~2LIT ", ";% 07295120
SI~LOC F; SI~SI+1;% 07295130
DS~5 CHR;% 07295140
END ELSE% MORE THAN 1 07295150
AQ: BEGIN DS~3 LIT "S, "; %511-07295160
SI~LOC S; SI~SI+1;% 07295170
DS~5 CHR;% 07295180
DS~6 LIT " THRU ";% 07295190
SI~SI+4; DS~4 CHR;% 07295200
END;% 07295210
DS~LIT "~"; 07295220
END;% 07295230
SPOUT(I);% 07295235
END ELSE FORGETSPACE(I);% 07295240
$ POP OMIT 07295241
UNLOCKCONTROLKECKS; 07296000
END;% 07297000
PROCEDURE REMOVEDECK(N,TUSTA);VALUE N,TUSTA;REAL N,TUSTA; 07298000
BEGIN REAL I,T,A,L1,J=I,L2,V;% 07299000
$ SET OMIT = NOT(PACKETS) 07299499
REAL L3; 07299500
LABEL FAIL,CONTINUE; 07299600
$ POP OMIT 07299601
LABEL L,EXIT,REMOVE;% 07300000
LOCKCONTROLDECKS; 07301000
IF (I ~ DIRECTORYSEARCH("DECK ",N,5)) = 0 THEN% 07303000
$ SET OMIT = NOT(PACKETS) 07303499
FAIL: 07303500
$ POP OMIT 07303501
BEGIN I ~ SPACE(5);% 07304000
STREAM(N,I);% 07305000
$ SET OMIT = NOT(PACKETS) 07305099
BEGIN DS:=5 LIT " PKT "; 07305100
$ POP OMIT 07305101
$ SET OMIT = PACKETS 07305999
SI ~ LOC N; SI ~ SI+1; DS ~ 5 CHR;% 07307000
DS ~ 13 LIT " NOT ON DISK~";% 07308000
END;% 07309000
GO TO EXIT;% 07310000
END;% 07311000
$ SET OMIT = NOT(SHAREDISK) 07311199
$ SET OMIT = NOT(PACKETS) 07311499
L3:=M[I+6].[FF]; 07311500
$ POP OMIT 07311501
L2:=M[I+6].[CF]; 07312000
IF (A:=FIRSTDECK)=(L1:=I.[FF]) THEN 07313000
BEGIN 07314000
$ SET OMIT = PACKETS 07314099
$ SET OMIT = NOT(PACKETS) 07314109
FIRSTDECK:=IF L3 NEQ 0 THEN L3 ELSE L2; 07314110
IF L2=0 THEN LASTDECK~IF L3 NEQ 0 THEN L3 ELSE 0; 07314120
$ POP OMIT 07314121
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); 07314200
$ SET OMIT = NOT(PACKETS) 07314289
IF L3 NEQ 0 THEN GO TO CONTINUE ELSE 07314290
$ POP OMIT 07314291
GO TO REMOVE; 07314300
END; 07314400
J ~ I.[33:15];% 07315000
L: 07316000
DISKWAIT(-J,30,A); 07317000
IF (V:=M[J+6].[CF])=0 THEN 07318000
$ SET OMIT = NOT(PACKETS) 07318009
IF A=L1 THEN GO REMOVE ELSE BEGIN FORGETSPACE(I); GO FAIL 07318010
END; 07318012
$ POP OMIT 07318013
$ SET OMIT = PACKETS 07318019
IF V ! L1 THEN% 07319000
BEGIN A ~ V; GO TO L END;% 07320000
$ SET OMIT = PACKETS 07320999
$ SET OMIT = NOT(PACKETS) 07321099
M[J+6].[CF]~IF L3!0 THEN L3 ELSE L2; 07321100
$ POP OMIT 07321101
DISKWAIT(J,30,A); 07322000
IF L2 = 0 THEN% 07324000
BEGIN 07325000
$ SET OMIT = PACKETS 07325999
$ SET OMIT = NOT(PACKETS) 07326099
LASTDECK:=IF L3 NEQ 0 THEN L3 ELSE A; 07326100
$ POP OMIT 07326101
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); 07327000
$ SET OMIT = PACKETS 07327999
$ SET OMIT = NOT(PACKETS) 07329999
END ELSE IF L3=0 THEN ELSE 07330000
CONTINUE: 07330050
BEGIN J~I INX 0; 07330100
DISKWAIT(-J,30,L3); 07330200
M[J+6].[CF]~L2; 07330300
DISKWAIT(J,30,L3); 07330400
END; 07330500
$ POP OMIT 07330501
REMOVE: 07331000
FORGETSPACE(I); 07332000
I:=DIRECTORYSEARCH("DECK ",N,8).[CF]; 07333000
T ~ M[I+9];% 07343000
FOR V ~ 1 STEP 1 UNTIL T DO% 07344000
IF M[I+V+9]!0 THEN FORGETUSREDISK(M[I+V+9],M[I+8]); 07345000
STREAM(N,I);% 07346000
$ SET OMIT = NOT(PACKETS) 07346099
BEGIN DS:=5 LIT " PKT "; 07346100
$ POP OMIT 07346101
$ SET OMIT = PACKETS 07346999
SI ~ LOC N; SI ~ SI+1; DS ~ 5 CHR;% 07348000
DS ~ 9 LIT " REMOVED~";% 07349000
END;% 07350000
$ SET OMIT = PACKETS 07350099
EXIT: SPOUTER(I&TUSTA[9:9:9],TUSTA,LIBMSG) 07351000
$ SET OMIT = PACKETS 07351099
;UNLOCKCONTROLDECKS; 07352000
END;% 07353000
PROCEDURE DECKREMOVER(B); BALUE B; REAL B;% 07354000
BEGIN REAL K,N,F;% 07355000
INTEGER U; LABEL ON,ERR; 07355100
REAL D; 07355200
LABEL L,TRYIT,GIVEUP; 07356000
K ~ B.[15:15]-1;% 07357000
L: STREAM(X~12,B:A~0);% 07358000
BEGIN SI ~ B;% 07359000
U: IF SC = " " THEN BEGIN SI~SI+1; GO TO U END;% 07360000
IF SC="=" THEN BEGIN DI~LOC X; DI~DI+6; DS~CHR; 07360100
SI~SI-1; B~SI; GO TO E END;07360200
IF SC = "#" THEN SI:=SI+1; 07361000
BL: IF SC=" " THEN BEGIN SI:=SI+1;GO TO BL; END; 07361500
DI:=LOC X; DI:=DI+1; DS:=5 LIT "#0000"; 07362000
4(IF SC < "0" THEN JUMP OUT TO EN; 07363000
IF SC > "9" THEN JUMP OUT TO EN; 07364000
SI:=SI+1; TALLY:=TALLY+1); 07365000
EN: A:=TALLY; SI:=SI-A; DI:=DI-A; DS:=A CHR; 07365500
N: IF SC = " " THEN BEGIN SI~SI+1; GO TO N END;% 07366000
DS ~ CHR; B ~ SI;% 07367000
E: END;% 07368000
P(.B,~,.N,~);% 07369000
F~N.[36:6]; N.[36:6]~"~"; 07370000
IF F="~" OR F="," OR F="=" THEN 07371000
BEGIN IF F="=" THEN 07371100
BEGIN IF D=0 THEN D~SPACE(30); 07371200
LOCKCONTROLDECKS; 07371300
IF (N:=FIRSTDECK)=0 THEN 07371400
GIVEUP: 07371450
BEGIN F:="~"; 07371500
UNLOCKCONTROLDECKS; 07371600
GO ON; 07371700
END; 07371750
TRYIT: DISKWAIT(-D,30,N); 07371800
$ SET OMIT = NOT(SHAREDISK) 07371809
N:=M[D+2]; 07371900
UNLOCKCONTROLDECKS; 07371950
END; 07372000
FOR U ~ 0 STEP 1 UNTIL PSEUDOMAX DO 07372090
IF CIDROW[U]!0 THEN 07372100
IF(CIDTABLE[U,2] EQV N)=NOT 0 THEN 07372200
IF LABELTABLE[U+32]}0 07372300
$ SET OMIT = NOT(PACKETS) 07372309
AND LABELTABLE[U+32]!@214 AND 07372310
PACKETACT[U]=0 07372320
$ POP OMIT 07372321
THEN 07372330
BEGIN 07372400
ENDOFDECK(U,M[K-1]); 07372500
GO ON; 07372600
END ELSE GO TO ERR; 07372700
REMOVEDECK(N,M[K-1]); 07372800
ON: IF F!"~" THEN GO TO L; 07372900
FORGETSPACE(K);% 07373000
END ELSE 07374000
ERR: SPOUT(K INX M[K-1]); 07374100
IF D!0 THEN FORGETSPACE(D); 07374200
END;% 07375000
BOOLEAN PROCEDURE READEMFROMDISK(H,IB);% 07376000
VALUE H,IB; ARRAY H[*],IB[*];% 07377000
BEGIN% 07378000
% H[0] = ADDRESS OF BU+1 (B)% 07379000
% H[1] = ADDRESS OF B2+1% 07380000
% H[2] = DECK NAME% 07381000
% H[3] = RECORDCOUNT (N)% 07382000
% H[4] = NEXT CONTROL CARD (L)% 07383000
% H[5] = RECORDS USED IN THIS BLOCK | 10 (R)% 07384000
% H[7] - H[30] ARE FILE HEADER% 07385000
REAL A,B;% 07386000
DEFINE N=H[3]#,L=H[4]#,R=H[5]#;% 07387000
INTEGER I=A; DEFINE MOM=CIDROW[M[B]]#; 07388000
$ SET OMIT = NOT(BREAKOUT) 07388010
B ~ H[0];% 07389000
IF R = 0 THEN% 07390000
IF (M[B-2] AND IOMASK) = 0 THEN% 07391000
SLEEP([M[B-2]],IOMASK);% 07392000
STREAM(B!B+R,IB);% 07393000
BEGIN SI ~ B; DS ~ 10 WDS END;% 07394000
M[IB INX NOT 0] ~ 10; 07394500
IF (READEMFROMDISK ~ N=L) THEN% 07395000
L ~ IB[9];% 07396000
IF (A:=N:=*P(DUP)+1) > (H[7]+1) THEN %639-07397000
BEGIN READEMFROMDISK:=1; 07398000
STREAM(IB); 07398100
BEGIN 07398200
$ SET OMIT = NOT(PACKETS) 07398299
DS:=8LIT" "; SI:=IB; DS:=8 WDS; DI:=IB; 07398300
$ POP OMIT 07398301
DS:=5LIT"-END."; DI:=DI-5; DS:=RESET; 07398400
END; 07398500
END 07398600
ELSE BEGN IF (R ~ *P(DUP)+10) = 30 THEN% 07399000
BEGIN IB ~ [M[B-2]];% 07400000
R ~ 0; 07400400
A ~ A DIV 3+1; 07400500
I~H[A DIV H[8]+10]+A MOD H[8]; 07401000
IF I>0 THEN % NEXT BUFF EXISTS %639-07401900
DISKIO(IB,1-B,30,I);% 07402000
H[0] ~ H[1];% 07403000
H[1] ~ B;% 07404000
END; END; END;% 07405000
BOOLEAN PROCEDURE PRINTORPUNCHWAIT(Q,PNCH);VALUE Q,PNCH;REAL Q,PNCH; 07405100
FORWARD; 07405110
PROCEDURE ENDOFDECK(R,TUSTA);VALUE R,TUSTA; REAL R,TUSTA; 07406000
BEGIN ARRAY H[*];% 07407000
REAL B,I;% 07408000
$ SET OMIT = NOT(PACKETS) 07408099
REAL DISKAD,PBREC,T,USERIO; % %750-07408100
$ POP OMIT 07408101
LABEL EXIT; 07408500
IF (H:=CIDROW[R])=0 THEN GO TO EXIT; 07409000
LABELTABLE[R+32] ~ @114; 07409100
MULTITABLE[R+32] ~ RDCTABLE[R+32] ~ 0; 07409200
USERID~UNITCODE[R+29]; % %750-07409250
UNITCODE[R+9]:=-0; 07409300
IF NOT TUSTA.[1:1] THEN REMOVEDECK(H[2],ABS(TUSTA)) ELSE 07410000
P(DIRECTORYSEARCH(-"DECK ",H[2],14),DEL);07410100
FOR I ~ 0 STEP 1 UNTIL 1 DO% 07411000
BEGIN B ~ H[I];% 07412000
IF (M[B-2] AND IOMASK) = 0 THEN 07413000
SLEEP([M[B-2]],IOMASK);% 07414000
END;% 07415000
IF CIDROW[R]=0 THEN GO TO EXIT; % FIXES TIMING PROB. 07415100
IF H.[18:15] ! 0 THEN 07416000
FORGETSPACE(H.[18:15]-2); 07417000
$ SET OMIT = NOT(PACKETS) 07417099
IF PACKETPBD[R] GEQ 11 THEN 07417100
BEGIN 07417200
PBCOUNT := PBCOUNT+1; 07417300
I := 001 & CIDTABLE[R,6][6:6:24]; 07417400
IF (PBREC := DIRECTORYSEARCH("PBD ",I,5))!0 THEN 07417500
BEGIN 07417600
IF PACKETPAGE[R]>1 THEN 07417700
BEGIN 07417800
PBREC := PBREC.[CF]; 07417900
T := M[PBREC+6]; 07418000
DISKAD := M[PBREC+10]+2; 07418100
DISKWAIT(-PBREC,30,DISKAD); 07418200
IF (M[PBREC+12] EQV (-"ABORTED"))=NOT 0 THEN 07418300
STREAM(B:=PBREC+11); 07418500
BEGIN 07418600
DS:=8LIT":|0|4000"; DS:=8LIT"0PACKET "; 07418700
END; 07418800
M[PBREC+15]~M[PBREC+27]~USERID; % %750-07418850
DISKWAIT(PBREC,30,DISKAD); 07418900
END; 07419000
P(DIRECTORYSEARCH(-"PBD ",1,14),DEL); 07419100
IF AUTOPRINT OR T0 THEN 07419200
P(PRINTORPUNCHWAIT(I,0&T[9:39:9[),DEL); 07419300
FORGETSPACE(PBREC); 07419400
END; 07419500
END; 07419600
PSEUDO[R] := 07419700
$ POP OMIT 07419701
CIDROW[R] := 0; 07419800
IF(RUNUMBER~RUNUMBER+1)>0 THEN 07420000
STARTADECK(IF TUSTA.[1:1] THEN -H[2] ELSE 0); 07420010
FORGETSPACE(H); 07420050
EXIT: 07420100
END;% 07421000
% PSEUDOCOPY DECLARATION MOVED TO 02347110 TO %541-07421500
% ALLOW ACCESS IN DRANO %541-07421505
PROCEDURE STARTADECK(N); VALUE N; REAL N; 07422000
BEGIN LABEL EXIT,L,POSSIBLE,NEXT;% 07423000
REAL I,R,T,A,S; 07424000
READ SDED; 07424100
ARRAY H[*];% 07425000
LABEL AGAIN,START; 07425500
START: 07425600
IF N.[1:1] THEN BEGN SDED~ABS(N); N~0 END; 07425700
LOCKCONTROLDECKS; 07426000
IF RUNUMBER LEQ 0 AND N=0 THEN GO TO EXIT; 07426100
AGAIN: 07427500
IF PSEUDOCOPY > 2 THEN% TOO MANY COPIES CONTROLCARD 07427600
IF STARTOG AND N=0 THEN GO TO EXIT % 07427610
ELSE BEGIN STARTOG ~ TRUE; 07427620
UNLOCKCONTROLDECKS; 07427625
COMPLEXSLEEP(PSEUDOCOPY { 2);% 07427630
STARTOG ~ FALSE;% 07427640
GO TO START;% 07427645
END;% 07427650
FOR R ~ 0 STEP 1 UNTIL PSEUDOMAX DO 07428000
IF CIDROW[R] = 0 THEN GO TO POSSIBLE;% 07429000
STREAM(S~S~SPACE(4)); 07429100
DS:=27 LIT" ALL PSEUDO-READERS IN USE~"; 07429200
SPOUT(S); 07429300
GO TO EXIT;% 07430000
POSSIBLE:% 07431000
IF (A:=FIRSTDECK)=0 THEN GO TO EXIT; 07432000
LABELTABLE[R+32]:=@114; 07432100
W~CIDROW[R]~[M[S~GETSPACE(94,20,1)+2]]&94[8:38:10]; 07433000
M[S-2].[9:6] ~ 0; H[2] ~ 0;% 07434000
L: DISKWAIT(-S,30,A); 07435000
IF N!0 THEN 07436000
BEGIN 07436100
IF H[2].[12:24]~N THEN GO TO NEXT; 07436200
IF H[4].[2:1] THEN 07436300
BEGIN 07436400
STREAM(A:=[H[2]], 07436500
$ SET OMIT = NOT(SHAREDISK) 07436509
S); 07436520
$ SET OMIT = PACKETS 07436599
$ SET OMIT = NOT(PACKETS) 07436609
BEGIN SI:=A;SI:=SI+1;DS:=5 LIT" PKT "; 07436610
$ POP OMIT 07436611
SI:=5 CHR;DS:=7LIT" IN USE"; 07436700
$ SET OMIT = NOT(SHAREDISK) 07436799
DS:=LIT"~"; 07437000
END; 07437100
SPOUT(S); 07437200
CIDROW[R]:=0; 07437300
GO TO EXIT; 07437400
END; 07437500
END ELSE 07437600
IF H[4].[2:1] OR (SDED!0 AND H[2]=SDED) 07437800
$ SET OMIT = NOT(SHAREDISK) 07437899
THEN GO TO NEXT; 07438000
H[4]:=(*P(DUP))&2[2:46:2]&SYSNO[4:46:2]; 07438100
DISKWAIT(S,30,A); 07438200
$ SET OMIT = NOT (DATACOM AND RJE) 07438250
H[0] ~ S+32;% 07441000
H[1] ~ S+64;% 07442000
T ~ [H[30]]; DISKIO(T,1-H[0],30,H[10]);% 07444000
IF H[7] LSS 3 THEN H[62]:=IOMASK ELSE 07445000
BEGIN T:=[H[62]]; IF H[8]=1 THEN 07445100
DISKIO(T,1-H[1],30,H[11]) ELSE 07445200
DISKIO(T,1-H[1],30,H[10]+1); 07445300
END; 07445400
T:=GTSPACE(13,20,0)+4; 07446000
$ SET OMIT = NOT(BREAKOUT) 07446010
M[T INX 10] := H[5]; 07446100
$ SET OMIT = NOT(PACKETS) 07446149
T.[24:6]+H[6].[2:6]; 07446150
$ POP OMIT 07446151
H[3] := H[4] := H[5] := H[6] := 0; 07446200
M[T-4].[9:6] ~ 0;% 07447000
LABELTABLE[R+32]~-@14; %LET IT BE MOVED 07448000
I~READEMFROMDISK(H,[M[T]]&10[8:38:10]); 07448500
INDEPENDENTRUNNER(P(.CONTROLCARD),T& 07449000
$ SET OMIT = NOT(DATACOM AND RJE ) 07449099
(R+32)[2:42:6],192); 07449200
PSEUDOCOPY ~ PSEUDOCOPY + 1;% 07449500
IF (RUNUMBER~RUNUMBER-1) LEQ 0 OR N!0 THEN GO TO EXIT; 07450000
GO TO AGAIN; 07450200
NEXT:IF (A:=H[6].[CF])!0 THEN GO TO L; 07451000
IF N!0 THEN 07452000
BEGIN 07452100
STREAM(N,S); 07452200
$ SET OMIT = PACKETS 07452299
$ SET OMIT = NOT(PACKETS) 07452309
BEGIN SI~LOC N; SI~SI+4; DS:=6 LIT" PKT #"; 07452310
$ POP OMIT 07452311
DS:=4 CHR;DS:=13 LIT" NOT ON DISK~"); 07452400
END; 07452500
SPOUT(S); 07452600
END ELSE FORGETSPACE(S); 07452700
CIDROW[R] ~ 0;% 07453000
EXIT: UNLOCKCONTROLDECKS; 07455000
END;% 07456000
PROCEDURE RUNTHEDECK(B);VALUE B; REAL B;% 07457000
BEGIN REAL I,J;% 07458000
STREAM(S:=0:B,A:=[I]); 07461000
BEGIN SI ~ B;% TO REAL IN I 07461100
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 07461120
IF SC="#" THEN 07461140
BEGIN 07461160
L1: SI:=SI+1; IF SC=" " THEN GO TO L1; 07461180
DS:=8 LIT"00000000"; 07461200
4(IF SC<"0" THEN JUMP OUT; 07461220
IF SC>"9" THEN JUMP OUT; 07461240
SI:=SI+1; TALLY:=TALLY+1); 07461260
S:=TALLY; SI:=SI-S; DI:=DI-S; DS:=S CHR; 07461280
TALLY:=1; 07461300
GO TO FX; 07461320
DS:=4 LIT"0000";DS:=4 CHR;TALLY:=1;GO TO EX; 07461330
END; 07461340
SI ~ SI + 1;% 07461400
IF SC { "9" THEN IF SC } "0" THEN GO TO TWO; 07461500
SI ~ SI - 1; DS ~ OCT;% 07461510
GO TO EX; 07461520
TWO: SI ~ SI - 1; DS ~ 2 OCT; 07461530
EX:S:=TALLY; 07461540
END; 07461550
J:=P; 07461560
B:=B.[15:15]-1; 07461570
IF J THEN 07461600
BEGIN 07461700
FORGETSPACE(B); 07461800
STARTADECK(I); 07461900
END ELSE 07462000
BEGIN 07462100
IF I GTR PSEUDOMAX1 THEN I:=NABS(RUNUMBER) ELSE 07462200
BEGIN 07462250
RUNUMBER:=I; 07462300
FOR J:=0 STEP 1 UNTIL PSEUDOMAX DO 07462400
RUNUMBER:=RUNUMBER-(CIDROW[J]!0); 07462500
END; 07462600
STREAM(X1:=1-I.[1:1],K2:=RUNUMBER.[1:1],I:=ABS(I),B);07463000
BEGIN CI:=CI+X1; GO L1; DS:=10LIT" WILL USE ";GO L2; 07464000
L1: CI:=CI+X2; GO L2; DS:=LIT"-"; L2: 07464100
SI:=LOC I;DS:=2 DEC; 07465000
DS ~ 13 LIT " PSEUDO-RDRS~"; 07466000
END;% 07467000
SPOUT(B INX M[B-1]); 07468100
IF RUNUMBER GTR 0 THEN STARTADECK(0); 07469000
END; 07472500
END;% 07473000
PROCEDURE EXTERNALEND(B); VALUE B; REAL B; 07473100
BEGIN REAL U; LABEL EXIT; 07474000
U ~ UNITIN(TINU,B); 07475000
B ~ B.[15:15]-1; 07476000
IF 32 { U AND U { PSEUDOMAXT THEN 07477000
IF LABELTABLE[U] } 0 THEN 07478000
$ SET OMIT = NOT(PACKETS) 07478099
IF LABELTABLE[U] NEQ @214 AND PACKETACT[U=32]=0 THEN 07478100
$ POP OMIT 07478101
IF CIDROW[U-32] ! 0 THEN 07478500
BEGIN 07479000
ENDOFDECK[U-32],M[B-1]); 07479100
FORGETSPACE(B); 07480000
GO TO EXIT; 07481000
END; 07482000
SPOUT(B INX M[B-1]); 07483000
EXIT:END; 07484000
PROCEDURE CHANGEPRIORITY(BUFF,MIX); VALUE BUFF,MIX; REAL BUFF,MIX; 07485000
BEGIN INTEGER PRIORITY; REAL B; 07486000
$ SET OMIT = NOT(PACKETS) 07486499
DEFINE UNITNO = PSEUDOMIX[MIX]#; 07486500
$ POP OMIT 07486501
BUFF ~ ((B~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 07487000
STREAM(PRIORITY:B); 07488000
BEGIN SI~B; 07489000
N: IF SC="~" THEN GO TO X; 07490000
IF SC<"0" THEN BEGIN SI~SI+1; GO TO N; END; B~SI; 07491000
K: IF SC}"0" THEN IF SC{"9" THEN 07492000
BEGIN TALLY~TALLY+1; SI~SI+1; GO TO K END; 07493000
SI~B; DI~LOC PRIORITY; B~TALLY; DS~B OCT; GO TO Z; 07494000
X: DI~LOC PRIORITY; SKIP DB; DS~11 SET; 07495000
Z: 07496000
END STREAM; 07497000
IF (PRIORITY~P) } 0 THEN 07498000
IF PRYOR[MIX]}0 THEN% 07501000
IF JAR[MIX,*]~0 THEN 07502000
BEGIN JAR[MIX,2].[CF]~ PRYOR[MIX]~ P(PRIORITY~ 07503000
IF PRIORITY}32766 THEN 32766 ELSE PRIORITY, DUP) & P[CTF]; 07503500
STREAM(J~JAR[MIX,*],MIX,PRIORITY,BUFF); 07504000
BEGIN DS~10 LIT " PRIORITY="; 07505000
SI~LOC PRIORITY; BUFF~DI; DS~6 DEC; DI~DI-6; 07506000
DS~5 FILL; DI~BUFF; DI~DI+6; DS~LIT":"; 07507000
SI~J; SI~SI+1; DS~7 CHR; SI~SI+1; DS~LIT"/"; DS~7 CHR;07508000
DS~LIT"="; SI~LOC MIX; DS~2DEC; DS~LIT"~"; 07509000
DI~DI-3; DS~FILL; 07509500
END END; 07510000
SPOUTER(BUFF,UNITNO,1); 07511000
END CHANGEPRIORITY; 07512000
PROCEDURE ENTERCONTROLDECK(H); VALUE H; ARRAY H[*]; 07541000
BEGIN REAL R,S,T,T1,T2; 07542000
INTEGER I; 07543000
$ SET OMIT = NOT(PACKETS) 07543099
LABEL MORE; 07543100
$ POP OMIT 07543101
T~"DECK "&H[4][1:47:1]; % FOR SCRATCHDIR DELETE 07545000
S:=NEXTCDNUM(0); 07547000
DISKWAIT(KLUMP,3,DIRECTORYTOP+3); % CHANGE LASTCDNUM ON DISK07547100
$ SET OMIT = NOT(PACKETS) 07547499
MORE: 07547500
$ POP OMIT 07547501
H[0]:=@001200036000301; 07548000
$ SET OMIT = NOT(PACKETS) 07548099
T2~H[6].[FF]; H[6].[FF]~T; 07548100
$ POP OMIT 07548101
STREAM(DATE,B~[H[3]]); 07549000
BEGIN SI~LOC DATE;DS~8 OCT;DI~DI-8;DS~2 LIT"+7";END; 07549100
H[4] := 0& 07550000
$ SET OMIT = NOT SHAREDISK 07550003
15[12:44:4]; 07550010
H[1]~(XCLOCK+P(RTR))&H[3][6:30:18]; 07550100
H[2]:=S:=@14&@12[6:42:6]&S[12:24:24]&@37[36:42:6]; 07557000
T1:=EUF(T,S,H.[CF]-1); 07559000
$ SET OMIT = NOT(PACKETS) 07559099
IF T2 NEQ 0 THEN 07559100
BEGIN DISKWAIT(-(H INX 0), 30, T2); 07559110
FORGETSPACE(T2); 07559120
S~H[2]; GO TO MORE; 07559180
END; 07559190
$ POP OMIT 07559191
H[2]~LASTCDNUM; 07559500
IF FIRSTDECK=0 THEN FIRSTDECK:=T1 ELSE 07560000
BEGIN 07561000
$ SET OMIT = SHAREDISK 07561990
LOCKDIRECTORY; 07562000
$ POP OMIT 07562010
DISKWAIT(-(I:=SPACE(30)),-30,LASTDECK); 07564000
M[I+6].[CF]:=T1; 07565000
DISKWAIT(I,-30,LASTDECK); 07566000
FORGETSPACE(I); 07567000
$ SET OMIT = SHAREDISK 07567990
UNLOCKDIRECTORY; 07568000
$ POP OMIT 07568010
END; 07569000
LASTDECK:=T1; 07570000
DISKWAIT(KLUMP,-3,DIRECTORYTOP+3); 07571000
UNLOCKTOG(CDMASK); 07572000
IF RUNUMBER GTR 0 THEN STARTADECK(0); 07573000
END ENTERCONTROLDECK; 07575000
BOOLEAN PROCEDURE MTXIN(I,U,BUFF);% 08000000
REAL U,BUFF; INTEGER I;% 08001000
BEGIN LABEL EXIT,X;% 08002000
U ~ UNITIN(TINU,BUFF); 08003000
BUFF ~ BUFF.[15:15]-1; 08004000
IF U > 15 THEN% 08005000
BEGIN;STREAM(BUFF); DS ~ 8 LIT "INV KBD ";% 08006000
GO TO EXIT;% 08007000
END ELSE I ~ TWO(U); 08008000
STREAM(A~TINU[U];BUFF);% 08009000
BEGIN SI~LOC A; SI~SI+5; DS~LIB" "; DS~3 CHR;% 08010000
DS ~ LIT " "; A ~ DI;% 08011000
END;% 08012000
P([BUFF].~);% 08013000
IF LABELTABLE[U] = @114 OR LABELTABLE[U] = @214 THEN% 08014000
BEGIN 08015000
STREAM(SAV:=((I AND SAVEWORD) NEQ 0), BUFF); 08015100
BEGIN 08015200
DS:=10LIT"NOT READY~"; 08015300
SAV(DI:=DI-1; DS:=8LIT"*SAVED)~"); 08015400
END; 08015500
GO TO EXIT; 08016000
END;% 08017000
IF LABELTABLE[U] < 0 THEN% 08018000
BEGIN;STREAM(BUFF); DS ~ 7 LIT "IN USE~";% 08019000
END% 08020000
ELSE GO TO X;% 08021000
EXIT:MTXIN ~ TRUE;% 08022000
X:END;% 08023000
PROCEDURE TAPEPURGE(BUFF); VALUE BUFF; REAL BUFF;% 08024000
BEGIN LABEL EXIT;% 08025000
REAL I,U;% 08026000
REAL R,T; 08027000
BOOLEAN TEST; 08027100
REAL WHAT = BUFF;% 08028000
IF MTXIN(I,U,WHAT) THEN GO TO EXIT;% 08029000
STREAM(B:=BUFF,T~[T]); 08029015
BEGIN SI:=B; SI:=SI+6; 08029020
IF SC="-" THEN 08029025
BEGIN SI:=SI+1; 08029030
5(IF SC="~" THEN JUMP OUT; 08029035
TALLY:=TALLY+1;SI:=SI+1); 08029040
B:=TALLY; SI:=SI-B; DS:=B OCT; 08029045
DI~DI-8; DS:=LIT "+"; %725-08029046
END; 08029050
END; 08029055
LABELTABLE[U] ~ -@14; 08029100
IF (R~WAITIO(@500000000,@177,U))!0 THEN 08030000
IF R!@120 THEN %ERROR OTHER THAN WRITE LOCK 08030100
BEGIN;STREAM(U~TINU[U],BUFF); 08030200
BEGIN DS~14 LIT "#CANNOT PURGE "; 08030300
SI~LOC U; SI~SI+5; DS~3CHR; 08030310
DS~LIT"~"; 08030320
END; 08030330
LABELTABLE[U]~@214; 08030400
GO TO EXIT; 08030500
END ELSE %NO WRITE RING 08030600
BEGIN; STREAM(BUFF); DS ~ 11 LIT "WRITE LOCK.";% 08031000
LABELTABLE[U] ~ @114; 08031100
GO TO EXIT;% 08032000
END;% 08033000
IF NOT T.[1:1] THEN IF T=0 THEN %725-08033980
BEGIN T:=PRNTABLE[U].[30:18]; TEST:= TRUE END; 08033990
IF I.[1:1]=0 AND T=0 THEN BEGIN %725-08033992
STREAM(BUFF); DS~17 LIT "NOT PG-ED(PRN=0)~"; %725-08033993
LABELTABLE[U]~ @14; GO EXIT END; T~ABS(T); %725-08033994
STREAM(A:=T,BUFF); 08034000
BEGIN DI ~ DI + 3; DS ~ 8 LIT " LABEL "; 08035000
8(DS~2 LIT "0X"); 08035100
24(DS~2 LIT "0"); DS~2 LIT "}!"; 08036000
DI ~ DI-21; SI ~ LOC A; DS ~ 5 DEC;% 08037000
END;% 08038000
RRRMECH ~ I OR RRRMECH;% 08039000
MULTITABLE[U] ~ 0;% 08041000
P(WAITIO(@4200000000,0,U),DEL);% 08042000
R ~ WAITIO(BUFF INX @120500000001,@2000000,U) OR% 08043000
WAITIO(BUFF INX 10,@2000000,U);% 08044000
IF MOD3IOS THEN %AI08044500
DO UNTIL P(WAITIO(BUFF INX @340000012,@50,U))=@10 %AI08044600
ELSE %AI08044700
P(WAITIO(@4200000000,0,U),DEL);% 08045000
SLEEP([TOGLE],STATUSMASK); 08046000
RRRMECH ~ RRRMECH AND NOT I;% 08047000
READY ~ READY AND NOT I;% 08048000
IF R = 0 THEN BEGIN% 08049000
LABELTABLE[U] ~ @114;% 08050000
IF TEST THEN BEGIN STREAM(B~T,BUFF); %708-08051000
BEGIN DS~10 LIT"PG-ED(PRN="; SI~LOC B; DS~5 DEC; DS~2 LIT")~";%708-08051004
END; END % PRINT PRN WITH PLAIN PGMT %708-08051005
ELSE BEGIN STREAM(A:=T,B:=PRNTABLE[U],[30:18],BUFF); 08051010
BEGIN DS:=10LIT"PG-ED(PRN="; 08051020
SI:=LOC A; DS:=5 DEC; 08051030
DS:=5LIT",WAS "; 08051040
SI:=LOC B; DS:=5 DEC;DS:=2LIT")~"; 08051050
END; 08051060
PRNTABLE[U].[30:18] ~ T; 08051065
END; 08051070
EXIT: SPOUT(NABS(BUFF INX M[BUFF-1]));% 08052000
END ELSE BEGIN% 08053000
LABELTABLE[U] ~ @214;% 08054000
FORGETSPACE(BUFF);% 08055000
END;% 08056000
END;% 08057000
PROCEDURE GIMEDATE(B,DT); VALUE B,DT; REAL B,DT; FORWARD; 08070000
PROCEDURE REWINDANDLOCK(WHAT); VALUE WHAT; REAL WHAT;% 08079000
BEGIN REAL BUFF=WHAT,U;% 08080000
INTEGER I;% 08081000
LABEL EXIT;% 08082000
IF MIXIN(I,U,BUFF) THEN GO TO EXIT;% 08083000
RRRMECH ! RRRMECH OR I;% 08084000
LABELTABLE[U] ~ -@14;% 08085000
MULTITABLE[U] ~ 0;% 08086000
P(WAITIO(@4200000000,0,U),DEL);% 08087000
SLEEP([TOGLE],STATUSMASK); 08088000
RRRMECH ~ RRRMECH AND NOT I;% 08089000
READY ~ READY AND NOT I;% 08090000
LABELTABLE[U] ~ @214;% 08091000
STREAM(BUFF); DS ~ 5 LIT "RW/L~";% 08092000
EXIT: SPOUT(BUFF INX M[BUFF-1]); 08093000
END;% 08094000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08095050
%**********************************************************************%08095100
%* *%08095150
%* P R I N T D I R E C T O R Y *%08095200
%* - - - - - - - - - - - - - - *%08095250
%* *%08095300
%* PURPOSE: THIS PROCEDURE HANDLES THE PD, EX, LF, LC AND LS *%08095350
%* MESSAGES. ALL MESSAGES ARE FORMS OF THE PD MESSAGE *%08095400
%* EXCEPT FOR CERTAIN DIFFERENCES. THE PD MESSAGE WILL *%08095450
%* LIST THE NAMES OF THE DESIRED FILES AS WELL AS *%08095500
%* CERTAIN PIECES OF INFORMATION IF REQUESTED. *%08095550
%* *%08095600
%* SYNTAX: THE FORMAT OF ALL THE KEYIN MESSAGES WITH THE *%08095650
%* EXCEPTION OF THE LF MESSAGE IS AS FOLLOWS: *%08095700
%* *%08095750
%* <MESSAGE> <FILE SPECIFIER> <OPTION-LIST> *%08095800
%* *%08095850
%* <MESSAGE> ::= PD / EX / LC / LS *%08095900
%* *%08095950
%* <FILE SPECIFIER> ::= <FILENAME> / <FILENAME> "/" *%08096000
%* <FILENAME> *%08096050
%* *%08096100
%* <OPTION-LIST> ::= <EMPTY> / <OPTION> / <OPTION> , *%08096150
%* <OPTION-LIST> *%08096200
%* *%08096250
%* <OPTION> ::= RECS / LAST / DATE / SAVE / SIZE / *%08096300
%* CREATOR / SECURITY / ALL *%08096350
%* *%08096400
%* <FILENAME> ::= [FROM 1 TO 7 CHARACTERS OPTIONALLY *%08096450
%* ENCLOSED IN QUOTES] / = *%08096500
%* *%08096550
%* THE SYNTAX FOR THE LF MESSAGE IS: *%08096600
%* *%08096650
%* LF <USERID> <OPTION-LIST> *%08096700
%* *%08096750
%* SEMANTICS: THE EX, LF, LC, AND LS MESSAGES ARE JUST *%08096800
%* MODIFIED FORMS OF THE PD MESSAGE. THE EX MESSAGE IS *%08096850
%* THE SAME AS A PD EXCEPT THAT ONLY THE EXPIRED FILES *%08096900
%* ARE LISTED. THE LF IS THE SAME AS A PD=/= EXCEPT *%08096950
%* THAT ONLY THE FILES BELONGING TO THE SPECIFIED USER *%08097000
%* ARE LISTED. THE LC MESSAGE IS THE SAME AS A "PD *%08097050
%* <FILE SPECIFIER> CREATOR". THE LS MESSAGE IS THE *%08097100
%* SAME AS "PD <FILE SPECIFIER> SECURITY,CREATOR". *%08097150
%* *%08097200
%* THE OPTIONS SPECIFY WHAT ADDITIONAL INFORMATION *%08097250
%* IS TO BE LISTED BESIDES THE DEFAULT INFORMATION, IF *%08097300
%* AN UNRECOGNIZABLE WORD IS ENCOUNTERED IN THE OPTION *%08097350
%* LIST, IT IS IGNORED. THE AVAILABLE OPTIONS ARE: *%08097400
%* *%08097450
%* RECS - NUMBER OF RECORDS IN THE FILE, (SPECIAL LOGIC *%08097500
%* IS INCORPORATED TO THE LIST THE CORRECT NUMBER *%08097550
%* FOR BACKUP FILES). *%08097600
%* *%08097650
%* LAST - LAST ACCESS DATE. *%08097700
%* *%08097750
%* DATE - CREATION DATE. *%08097800
%* *%08097850
%* SAVE - SAVE FACTOR. *%08097900
%* *%08097950
%* SIZE - SIZE OF THE FILE IN SEGMENTS. *%08098000
%* *%08098050
%* CREATOR - PRIVILEGED USERCODE ASSOCIATED WITH FILE. *%08098100
%* (FOR BACKUP FILES THE LABEL OF THE PRINT FILE *%08098150
%* AND THE NAME OF THE PROGRAM CREATING THE BACKUP *%08098200
%* IS ALSO LISTED). *%08098250
%* *%08098300
%* SECURITY - ACCESS PRIVILEGES OF THE FILE, I.E., *%08098350
%* LOCKED, UNLOCKED, PUBLIC, PRIVATE, FREE. *%08098400
%* *%08098450
%**********************************************************************%08098500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%08098550
PROCEDURE PRINTDIRECTORY(BUFF,CODE); %152-08098600
VALUE BUFF,CODE; %152-08098650
REAL BUFF, %152-08098700
BEGIN %152-08098750
%152-08098800
INTEGER %152-08098850
I, % NORMALLY CONTAINS OPTION NUMBER. %152-08098900
J; % JUNK. %152-08098950
%152-08099250
REAL %152-08099300
MFID, % MFID OF DESIRED FILE OR -1 IF "=". %152-08099350
FID, % FID OF DESIRED FILE OR -1 IF "=". %152-08099400
C, % ADDRESS OF DISK HEADER. %152-08099450
D, % MFID OF LAST FILE FOUND BY SEEKNAM. %152-08099500
E, % FID OF LAST FILE FOUND BY SEEKNAM. %152-08099550
N, % WORK VARIABLE USED BY SEEKNAM TO SAVE INFO. %152-08099600
T, % NORMALLY USED TO SAVE DEST. INDEX. %152-08099650
INFO, % BIT MASK FOR OPTIONS SELECTED. %152-08099700
LABELREC, % ADDRESS OF LABEL RECORD FOR PDB ( IF LC ). %152-08099750
STA, % ORIGINATING STATION. TU/BUFF IN [9:9] FIELD. %152-08099775
USERID, % USERID IF LF. %152-08099800
X; % JUNK. %152-08099850
%152-08099900
ARRAY %152-08099950
HDR[*], % DESCRIPTOR TO DISK HEADER. %152-08100000
XLST[*];% SOME DAY WE MAY ALLOW EXCEPTION LIST. %152-08100050
%152-08100100
BOOLEAN %152-08100150
PBDTOG, % TRUE IF SELECTED FILE IS A PBD. %152-08100200
FOUNDAFILE; % TRUE IF WE LISTED OUT AT LEAST ONE FILE. %152-08100250
%152-08100300
LABEL EXIT,DROPOUT,DUMMY,OPTIONS; %152-08100350
DEFINE NUMOPTS = 7#; %152-08100500
DEFINE %152-08100510
TUANDBUF = [9:9]%, % TU/BUFF STORED IN [9:9] FIELD. %152-08100520
STATUANDBUF = STA.TUANDBUF#; % TU/BUFF OF ORIGINATING STATION. %152-08100530
DEFINE PD = (CODE = 0)#, %152-08100550
EX = (CODE = 1)#, %152-08100600
LC = (CODE = 2)#, %152-08100650
LF = (CODE = 3)#, %152-08100700
LS = (CODE = 4)#; %152-08100750
DEFINE %152-08100800
PRIMARYUSER = HDR[2]#, % PRIV. USER CODE. %152-08100850
SAVEFACTOR = HDR[3].[2:10]#, % SAVE FACTOR. %152-08100900
LASTACCESSDATE = HDR[3].[12:18]#, % LAST ACCESS DATE. %152-08100950
CREATIONDATE = HDR[3].[30:18]#, % CREATION DATE. %152-08101000
GUARDFILEMFID = HDR[5]#, % MFID OF GUARD FILE. %152-08101050
GUARDFILEFID = HDR[6]#, % FID OF GUARD FILE. %152-08101100
PBDTUANDBUF = HDR[6].[39:9]#, % RJE TU/BUFF FOR PBD. %152-08101110
PBDTU = HDR[6].[39:4]#, % RJE TU NUMBER FOR PBD. %152-08101120
PBDBUF = HDR[6].[44:4]#, % RJE BUF NUMBER FOR PBD. %152-08101130
EOFPOINTER = HDR[7]#, % EOF POINTER. %152-08101150
SEGSPERROW = HDR[8]#, % SEG. POER ROW. %152-08101200
NOOFROWS = HDR[9].[43:5]#, % NO. OF ROWS DECLARED. %152-08101250
HEADERADDRESS = HDR.[CF]#; % CORE ADDRESS OF HEADER. %152-08101300
%******************** S U B R O U T I N E S **************************08101350
SUBROUTINE GETREADY; %152-08101400
% ---------- -------- %152-08101450
BEGIN %152-08101500
STA := M[(BUFF := (T:=BUFF).[15:15] -1) -1]; %152-08101520
$ SET OMIT = NOT(DATACOM) %152-08101540
INFO := 0 & (LC OR LF OR LS)[42:47:1] & LS[43:47:1]; %152-08101650
END OF GETREADY; %152-08101700
% %152-08101750
SUBROUTINE GETFILESPECIFIER; %152-08101800
% ---------- ---------------- %152-08101850
BEGIN %152-08101900
NAMEID(MFID,T); % GET MFID (OR USERCODE IF "LF") %152-08101950
IF LF THEN USERID := MFID; % FIRST THING IS USERID FOR LF. %152-08102000
IF MFID = "~~ " OR LF THEN %152-08102050
MFID := - 1; %152-08102100
NAMEID(FID,T); %152-08102150
IF FID = "/ " THEN % GET FID %152-08102200
BEGIN %152-08102250
NAMEID(FID,T); %152-08102300
NAMEID(N,T); % GET NEXT ITEM. %152-08102350
END %152-08102400
ELSE % NO FID SPECIFIED IMPLIES FID OF "=" %152-08102450
BEGIN %152-08102500
N := FID; %152-08102550
FID := -1; %152-08102600
END; %152-08102650
IF FID.[6:6] = LEFTARROW OR LF THEN % NO FID SPECIFIED %152-08102700
FID := - 1; %152-08102750
END OF GETFILESPECIFIER; %152-08102800
% %152-08102850
SUBROUTINE PROCESSOPTIONLIST; %152-08102900
% ---------- ----------------- %152-08102950
BEGIN %152-08103000
WHILE N ! "~ " DO % ACCUMULATE OPTIONS %152-08103050
BEGIN %152-08103100
FOR I := -1 STEP 1 UNTIL (NUMOPTS - 2) DO %152-08103150
DUMMY:: IF P(.OPTIONS,I,+,LOD) = N THEN % MATCHES AN OPTION WORD 08103200
BEGIN %152-08103250
INFO := INFO OR TWO(I+1); % SET BIT CORRESPONDING TO OPT08103300
GO TO DROPOUT; %152-08103350
END %152-08103400
ELSE % CHECK FOR "ALL" %152-08103450
IF N = "ALL " THEN % SET ALL OPTION WORD BITS. %152-08103500
INFO := NOT 0; %152-08103550
DROPOUT: %152-08103600
NAMEID(N,T); % GET NEXT OPTION WORD. %152-08103650
IF N = ", " THEN NAMEID(N,T); % SKIP OVER COMMA. %152-08103700
END; %152-08103750
GO TO EXIT; %152-08103800
% %152-08103850
OPTIONS ::: "RECS ", % OPTION 0 (INFO.[47:1]) %152-08103900
"LAST ", % OPTION 1 (INFO.[46:1]) %152-08103950
"DATE ", % OPTION 2 (INFO.[45:1]) %152-08104000
"SIZE ", % OPTION 3 (INFO.[44:1]) %152-08104050
"SECURIT", % OPTION 4 (INFO.[43:1]) %152-08104100
"CREATOR", % OPTION 5 (INFO.[42:1]) %152-08104150
"SAVE "; % OPTION 6 (INFO.[41:1]) %152-08104200
EXIT: %152-08104250
END OF PROCESSOPTIONLIST; %152-08104300
% %152-08104350
SUBROUTINE GETSET; %152-08104400
% ---------- ------ %152-08104450
BEGIN %152-08104500
IF EX OR INFO ! 0 OR (PD AND USERID ! 0) THEN % WE WILL NEED HDR. 08104550
HDR := IOQUE & SPACE(30) [CTC]; %152-08104600
END OF GETSET; %152-08104650
% %152-08104700
BOOLEAN SUBROUTINE WEGOTAFILE; %152-08104750
% ------- ---------- ---------- %152-08104800
BEGIN %152-08104850
SEEKNAM(MFID,FID,C,D,E,N,XLST); % FIND A FILE. %152-08104900
WEGOTAFILE := C ! 0; % C IS ADDRESS OF DISK HEADER. %152-08104950
END OF WEGOTAFILE; %152-08105000
% %152-08105050
BOOLEAN SUBROUTINE WEWANTTHISFILE; %152-08105100
% ------- ---------- -------------- %152-08105150
BEGIN %152-08105200
PBDTOG := ((D EQV "PBD ") = NOT 0 OR (D EQV "PUD ") %152-08105250
= NOT 0); %152-08105300
IF HEADERADDRESS ! 0 THEN % WE NEED THE HEADER. %152-08105350
DISKWAIT(-HEADERADDRESS,30,C); % READ HEADER. %152-08105400
IF LF THEN % CHECK TO SEE IF WE WANT THIS FILE. %152-08105450
WEWANTTHISFILE := PRIMARYUSER = USERID %152-08105500
ELSE %152-08105550
IF EX THEN %152-08105600
BEGIN %152-08105650
STREAM(A:=CALCULATEPURGE(-SAVEFACTOR),X:=[X]); %152-08105700
BEGIN %152-08105750
SI := LOC A; DS := 8 OCT; %152-08105800
END; %152-08105850
WEWANTTHISFILE := X > LASTACCESSDATE; % TRUE IF FILE EXPIRED08105900
END %152-08105950
ELSE %152-08106000
IF PD AND USERID ! 0 THEN % NEED TO CHECK SECURITY. %152-08106020
WEWANTTHISFILE := SECURITYCHECK(D,E,USERID,HEADERADDRESS)!0 08106040
ELSE %152-08106060
WEWANTTHISFILE := TRUE; %152-08106080
END OF WEWANTTHISFIE; %152-08106100
% %152-08106150
SUBROUTINE PUTINFILENAME; %152-08106200
% ---------- ------------- %152-08106250
BEGIN %152-08106300
STREAM(A:=0 : D, E, BUFF); % SET UP FILE NAME. %152-08106350
BEGIN %152-08106400
SI := LOC D; %152-08106450
DS := LIT " "; %152-08106500
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08106550
DI := DI - 1; %152-08106600
DS := 2 LIT " "; % NEED 2 SPACES TO ALLOW FOR ARROW. %152-08106650
A := DI; %152-08106700
END; %152-08106750
T := P; % SAVE OFF DEST. INDEX. %152-08106800
END OF PUTINFILENAME; %152-08106850
% %152-08106900
SUBROUTINE DORECS; %152-08106950
% ---------- ------ %152-08107000
BEGIN %152-08107050
STREAM(A:=IF PBDTOG THEN EOFPOINTER|5 ELSE EOFPOINTER+1 :T); %152-08107100
%152-08107150
BEGIN %152-08107200
DS := 9 LIT "RECORDS: "; %152-08107250
SI := LOC A; %152-08107300
DS := 8 DEC; % CONVERT NUMBER OF RECORDS TO DEC. %152-08107350
A := DI; % SAVE OFF DI BEFORE ZERO SUPPRESSING. %152-08107400
DI := DI - 8; %152-08107450
DS := 7 FILL; %152-08107500
END; %152-08107550
T := P; % SAVE DESTINATION ADDRESS. %152-08107600
END OF DORECS; %152-08107650
% %152-08107700
SUBROUTINE DODATEORLAST; %152-08107750
% ---------- ------------ %152-08107800
BEGIN %152-08107850
% %152-08107900
STREAM(X:=[X]); %152-08107950
BEGIN %152-08108000
SI := X; %152-08108050
DS := 8 DEC; % CONVERT DATE TO DECIMAL. %152-08108100
END; %152-08108150
GIMEDATE([X].[CF],-X); % CONVERT JUILIAN DATE TO 6 DIGITS. %152-08108200
STREAM(A:=(I=1) : X, T); %152-08108250
BEGIN %152-08108300
A ( DS := 10 LIT "ACCESSED: "; JUMP OUT TO L1); %152-08108350
DS := 9 LIT "CREATED: "; %152-08108400
L1: %152-08108450
SI := LOC X; %152-08108500
SI := SI + 2; %152-08108550
3 ( DS := 2 CHR; DS := LIT "/"); %152-08108600
DI := DI - 1; % ERASE THE EXTRA SLASH. %152-08108650
A := DI; % SAVE DEST. INDEX. %152-08108700
END; %152-08108750
T := P; % SAVE DESTINATION ADDRESS. %152-08108800
END OF DODATEORLAST; %152-08108850
% %152-08108900
SUBROUTINE DOSIZE; %152-08108950
% ---------- ------ %152-08109000
BEGIN %152-08109050
NT2 := NOOFROWS; % NO. OF ROWS DECLARED. %152-08109100
NT1 := 0; % NUMBER OF ROWS PROCESSED. %152-08109150
FOR J := 1 STEP 1 UNTIL NT2 DO % CHECK TO SEE IF ROW EXISTS. %152-08109200
IF HDR[J+9] ! 0 THEN NT1 := NT1 + 1; % BUMP UP COUNT. %152-08109250
STREAM(A:=NT1|SEGSPERROW : T); %152-08109300
BEGIN %152-08109350
DS := 10 LIT "SEGMENTS: "; %152-08109400
SI := LOC A; %152-08109450
DS := 8 DEC; %152-08109500
A := DI; %152-08109550
DI := DI - 8; %152-08109600
DS := 7 FILL; %152-08109650
END; %152-08109700
T := P; % SAVE DESTINATION ADDRESS. %152-08109750
END OF DOSIZE; %152-08109800
% %152-08109850
SUBROUTINE DOSECURITY; %152-08109900
% ---------- ---------- %152-08109950
BEGIN %152-08110000
J:= IF PRIMARYUSER = 0 THEN % FREE FILE %152-08110050
ELSE IF GUARDFILEMFID = "?" THEN % UNLOCK OR PUBLIC %152-08110100
IF GUARDFILEFID = "?" THEN 1 % UNLOCKED %152-08110150
ELSE 2 % PUBLIC %152-08110200
ELSE IF GUARDFILEMFID < 0 THEN 3 % PRIVATE %152-08110250
ELSE 4; % LOCKED %152-08110300
STREAM(J := A:=GUARDFILEMFID, B:=GUARDFILEFID, T); %152-08110350
BEGIN %152-08110400
DS := 10 LIT "SECURITY: "; %152-08110450
CI := CI + J; %152-08110500
GO TO FREE; %152-08110550
GO TO UNLOK; %152-08110600
GO TO PUBLIC; %152-08110650
GO TO PRIVATE; %152-08110700
LOCK: DS := 6 LIT "LOCKED"; GO TO EXIT; %152-08110750
PRIVATE:DS := 22 LIT "PRIVATE (SECURED WITH "; %152-08110800
SI := LOC A; %152-08110850
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08110900
DI := DI - 1; %152-08110950
DS := LIT ")"; %152-08111000
GO TO EXIT; %152-08111050
PUBLIC: DS := 6 LIT "PUBLIC"; GO TO EXIT; %152-08111100
UNLOK: DS := 8 LIT "UNLOCKED"; GO TO EXIT; %152-08111150
FREE: DS := 4 LIT "FREE"; %152-08111200
EXIT: J := DI; %152-08111250
END; %152-08111300
T := P; % SAVE DESTINATION ADDRESS. %152-08111350
END OF DOSECURITY; %152-08111400
% %152-08111450
SUBROUTINE DOCREATOR; %152-08111500
% ---------- --------- %152-08111550
BEGIN %152-08111600
$SET OMIT = PACKETS %152-08111650
$SET OMIT = NOT(PACKETS) %152-08111800
IF J:=(PBDTOG AND (E.[42:6] = 1)) THEN % REEL 1 OF PBD %152-08111850
$POP OMIT %152-08111900
BEGIN %152-08111950
IF LABELREC = 0 THEN LABELREC := SPACE(30); %152-08112000
DISKWAIT(-LABELREC,30,HDR[10]+2); %152-08112050
END; %152-08112100
STREAM(J : B:= PRIMARYUSER=0, C:=PRIMARYUSER, %152-08112150
RJE := PBDTUANDBUF!0, TU:=PBDTU, BUF:=PBDBUF, %152-08112175
D:=LABELREC INX 12, T); %152-08112200
BEGIN %152-08112250
DS := 9 LIT "CREATOR: "; %152-08112300
B ( DS := 4 LIT "NONE"; JUMP OUT TO L2 ); %152-08112350
SI := LOC C; %152-08112400
SI := SI + 1; %152-08112450
DS := 7 CHR; %152-08112500
L2: %152-08112550
J ( DS := 2 LIT " ("; %152-08112600
SI := D; %152-08112650
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08112700
DI := DI - 1; DS := 4 LIT " OF "; %152-08112750
2 ( SI := SI + 1; DS := 7 CHR; DS := LIT "/"); %152-08112800
DI := DI - 1; %152-08112820
RJE (DS := 2 LIT " ["; SI := TU; %152-08112840
DS := 2 DEC; DS := LIT "/"; DS := 2 DEC; %152-08112860
DS := LIT "]"); %152-08112880
DS := LIT ")"); %152-08112890
J := DI; %152-08112900
END; %152-08112950
T := P; % SAVE DESTINATION ADDRESS. %152-08113000
END OF DOCREATOR; %152-08113050
% %152-08113100
SUBROUTINE DOSAVEFACTOR; %152-08113150
% ---------- ------------ %152-08113200
BEGIN %152-08113250
STREAM(A := SAVEFACTOR : T); %152-08113300
BEGIN %152-08113350
DS := 6 LIT "SAVE: "; %152-08113400
SI := LOC A; %152-08113450
DS := 3 DEC; %152-08113500
A := DI; %152-08113550
DI := DI - 3; %152-08113600
DS := 2 FILL; %152-08113650
END; %152-08113700
T := P; % SAVE DESTINATION ADDRESS; %152-08113750
END OF DOSAVEFACTOR; %152-08113800
% %152-08113850
SUBROUTINE DOOPTIONS; %152-08113900
% ---------- --------- %152-08113950
BEGIN %152-08114000
FOR I := 0 STEP 1 UNTIL (NUMOPTS - 1) DO % SEE IF OPTION BIT SET. 08114050
IF (TWO(I) AND INFO) ! 0 THEN %OPTION SELECTED. %152-08114100
BEGIN %152-08114150
CASE I OF %152-08114200
BEGIN %152-08114210
DORECS; % CASE 0 - "RECS" %152-08114250
BEGIN % CASE 1 - "LAST" %152-08114290
X := LASTACCESSDATE; %152-08114300
DODATEORLAST; %152-08114310
END OF CASE 1; %152-08114320
BEGIN % CASE 2 - "DATE" %152-08114340
X := CREATIONDATE; %152-08114350
DODATEORLAST; %152-08114360
END OF CASE 2; %152-08114370
DOSIZE; % CASE 3 - "SIZE" %152-08114400
DOSECURITY; % CASE 4 - "SECURITY" %152-08114450
DOCREATOR; % CASE 5 - "CREATOR" %152-08114500
DOSAVEFACTOR; % CASE 6 - "SAVE" %152-08114550
END OF CASES; %152-08114600
STREAM(I : T); % PUT COMMA AFTER LAST OPTION. %152-08114650
BEGIN %152-08114700
DS := 2 LIT ", "; %152-08114750
I := DI; %152-08114800
END; %152-08114850
T := P; %152-08114900
END OF LOOP TO PROCESS OPTIONS; %152-08114950
END OF DOOPTIONS; %152-08115000
% %152-08115050
SUBROUTINE MAKETHEMESSAGE; %152-08115100
% ---------- -------------- %152-08115150
BEGIN %152-08115200
IF FOUNDAFILE THEN % WE NEED A BUFFER. %152-08115250
BUFF := SPACE(30); %152-08115300
PUTINFILENAME; %152-08115350
DOOPTIONS; %152-08115400
STREAM(T); % PUT IN THE LEFT ARROW. %152-08115450
BEGIN %152-08115500
DI := DI -2; %152-08115550
DS := LIT LEFTARROW; %152-08115600
END; %152-08115650
END OF MAKETHEMESSAGE; %152-08115700
% %152-08115750
SUBROUTINE COMPLAIN; %152-08115800
% ---------- -------- %152-08115850
BEGIN %152-08115900
STREAM(BUFF); %152-08115950
DS := 8 LIT " NULL "; % ORIGINAL INPUT IS AT BUFF + 1, %152-08116000
SPOUT(BUFF INX STA); %152-08116050
END OF COMPLAIN; %152-08116100
% %152-08116150
SUBROUTINE FORGETEVERYTHING; %152-08116200
% ---------- ---------------- %152-08116250
BEGIN %152-08116300
IF HEADERADDRESS ! 0 THEN FORGETSPACE(HEADERADDRESS); %152-08116350
IF LABELREC ! 0 THEN FORGETSPACE(LABELREC); %152-08116400
END OF FORGETEVERYTHING; %152-08116450
%******************** S T A R T O F C O D E ***********************08116500
GETREADY; %152-08116550
GETFILESPECIFIER; %152-08116600
PROCESSOPTIONLIST; %152-08116650
GETSET; %152-08116700
WHILE WEGOTAFILE DO %152-08116750
IF WEWANTTHISFILE THEN %152-08116800
BEGIN %152-08116850
MAKETHEMESSAGE; %152-08116900
SPOUT(BUFF INX STA); %152-08116950
FOUNDAFILE := TRUE; %152-08117000
END; %152-08117050
IF NOT FOUNDAFILE THEN COMPLAIN; %152-08117100
FORGETEVERYTHING; %152-08117150
END OF PRINTDIRECTORY; %152-08117200
$ SET OMIT = NOT(DCSPO AND DATACOM ) 08135999
PROCEDURE CONTINUITYBIT;% 08171000
BEGIN REAL T,IOD,LINK,U;% 08172000
ARRAY A[*]; 08172500
REAL RCW=+0;% 08173000
ARRAY R=-4[*]; DEFINE FIB=A#; %P 08173100
CHECKSTACKSPACE;% %WF 08173200
U ~(LINK ~ NFLAG(M[(IOD ~ NFLAG(M[T~PRT[P1MIX,9]]) INX% 08174000
P(0,LNG,XCH)) INX NOT 0])).[12:6];% 08175000
IF U } 32 THEN 08175100
BEGIN A ~ M[T]; 08175200
IF READEMFROMDISK(CIDROW[U-32],A) THEN 08175300
M[T] ~ A&1[27:47:1]&0[2:47:1] ELSE 08175400
M[1] ~ R; GO TO RETURN; 08175500
END; 08175600
M[IOD INX NOT 1]~FLAG(LINK); FIB~M[T-3]; %P 08176000
M[FIX[14]INX 17]~[M[FIB[5].[FF]]]&IOD[3:3:30]&0[20:20:1]; 08177000
;FIB[5]~P(DUP,LOD,0,1,CFX,ADD); %P 08177100
IF FIB[14].[FF]{FIB[14].[CF] THEN %% BUFFER FULL %P 08177200
PBIO(T,FIB[14]) %P 08178000
ELSE %P 08179000
BEGIN; STREAM(A~FIB[14].[CF], B~FIB[14].[FF]); %P 08179600
BEGIN SI~A; DS~18 WDS END; %P 08179700
FIB[14].[FF]~FIB[14].[FF]-18; %P 08179800
END; %P 08179900
GO RETURN %P 08180000
END CONTINUITYBIT; %P 08181000
BOOLEAN PROCEDURE PRINTORPUNCHWAIT(Q,PNCH);VALUE Q,PNCH;REAL Q,PNCH; 08255000
% 08255050
% THIS PROCEDURE IS RESPONSIBLE FOR STARTING PRNPBT/DISK. IT CHECKS 08255055
% FOR I/O UNITS AS REQUIRED AND, IF AVAILABLE, GRABS THEM. THE 08255060
% PARAMETERS ARE: 08255065
% Q {-16 LOGICAL UNIT NUMBER FOR OUTPUT. TAPES AND DISK ARE 08255070
% SEARCHED TO FIND A FILE TO PRINT. THIS IS USED ONLY 08255075
% WHEN AUTOPRINT IS SET OR FOR RJE. 08255080
% >-16, {0 LOGICAL UNIT NUMBER OF A BACK-UP TAPE. CHECK FOR AN 08255085
% AVAILABLE OUTPUT UNIT. 08255090
% >0 FID OF A DISK FILE. CHECK FOR OUTPUT UNIT. 08255095
% PNCH.[47:1] ON FOR PUNCH BACK-UP. 08255100
% [39:8] NUMBER OF COPIES FROM PB MESSAGE. 08255105
% [31:8] IF TAPE, NUMBER OF FILE TO PRINT (FROM PB). 08255110
% IF DISK, =0 IF ENTRIE PACKET SHOULD BE PRINTED, =1 IF08255115
% NOT. 08255120
% [30:1] ON IF =0 WAS USED IN PB MSG. 08255122
% [9:9] RJE TU/BUFF. 08255125
% [2:1] ON IF CALLED FROM PRINTBACKUP, I.E, A PB MESSAGE. 08255130
% [1:1] ON IF CALLED FROM PRNPBT/DISK. 08255135
% 08255140
BEGIN INTEGER U,V,I,J,J1,J2,S; 08255200
REAL A,HDR,SEG0=S,F=J; 08255400
REAL PBT,PBD,PUD; 08255500
ARRAY D[*],SHEAT=D[*]; 08255600
LABEL TRYAGAIN,PRNPBT,DISK; 08255700
LABEL FOUND,FIREITUP,QUIT; %717-08255800
DEFINE MFID = (IF V=22 THEN PUD ELSE PBD)#; 08255900
DEFINE STACURR = STATION[STA.[44:4],STA.[39:4]]#; 08256000
$ SET OMIT = SHAREDISK 08256190
DEFINE SIXTY = 60%; 08256200
$ SET OMIT = NOT SHAREDISK 08256210
$ SET OMIT = NOT RJE 08256390
% 08256420
SUBROUTINE LABELTHEPRINTER; 08256430
BEGIN LABELTABLE[V]:=Q&@21[1:43:5]; 08256440
MULTITABLE[V]:=IF V=22 THEN PUD ELSE PBD; 08256450
END; 08256460
% 08256470
PBT := "PBT "; PUD := "PUD "; PBD := "PBD "; 08256500
$ SET OMIT = NOT(DATACOM AND RJE ) 08256699
IF Q}(-15) THEN %%% PR GIVEN: LOOK FOR LP. 08257000
BEGIN 08257100
$ SET OMIT = NOT(DATACOM AND RJE ) 08257199
IF PNCH THEN IF LABELTABLE[V:=22]!0 THEN V:=0 ELSE ELSE 08257500
IF LABELTABLE[V~20]!0 THEN 08257600
IF LABELTABLE[V~21]!0 THEN V~0; 08258000
IF V!0 THEN % WE HAVE AN OUTPUT UNIT 08258200
IF Q>0 THEN % BACK-UP DISK 08258400
BEGIN U:=18; 08258600
LABELTHEPRINTER; % TO HOLD IT DURING DISK I/O-S. 08258700
IF AUTOPRINT % CHECK IF A PRNPBT WAS STARTED; 08258800
$ SET OMIT = NOT RJE % IF SO, START THIS ONLY FOR PB. 08258990
THEN 08259200
IF (A:=DIRECTORYSEARCH(MIFD,Q,19))!0 THEN 08259225
BEGIN IF M[A+4].[6:1] THEN% NOT FIRST TIME. 08259250
BEGIN 08259275
$ SET OMIT = NOT SHAREDISK 08259300
P(PNCH.[2:1]); % SEE 08259625 08259375
END ELSE % FIRST TIME, MARK IT. 08259400
BEGIN M[A+4].[6:1]:=1; 08259425
DISKWAIT(A.[CF],-30,A.[FF]); 08259450
P(1); 08259475
END; 08259500
FORGETSPACE(A); 08259525
$ SET OMIT = SHAREDISK 08259550
UNLOCKDIRECTORY; 08259575
$ POP OMIT 08259600
IF P THEN ELSE GO QUIT; 08259625
END ELSE GO QUIT; 08259650
GO FIREITUP; 08259700
END ELSE % Q{0, PB MT %717-08259800
BEGIN RRRMECH~TWO(U~ABS(Q)) OR RRRMECH; %717-08259810
LABELTABLE[U] ~ %717-08259820
PBT&TINU[V][6:30:18]&@21[1:43:5]; %717-08259830
MULTITABLE[V] ~ PBT; %717-08259840
LABELTABLE[V] ~ PBT&TINU[U][6:30:18]& %717-08259850
@21[1:43:5]; %717-08259860
GO FIREITUP; %717-08259870
END %717-08259880
ELSE GO QUIT; % V =0, NO OUTPUT UNIT 08260000
END; 08260250
BEGIN V:=ABS(Q); % LP (OR PUNCH) GIVEN, LOOK FOR FILE. 08260500
IF PBCOUNT!0 THEN % TRY FOR DISK 08267000
BEGIN D:=[M[SPACE(90)]]&90[8:38:10]; 08267500
$ SET OMIT = SHAREDISK 08267990
LOCKDIRECTORY; 08268000
$ POP OMIT 08268010
A:=MFID; 08268500
J1:=(A.[6:18] + A.[24:24]) MOD MODULUS; 08268600
FOR J2:=0 STEP 1 UNTIL (MODULUS-1) DO 08268700
BEGIN 08268750
$ SET OMIT = NOT SHAREDISK 08268790
J:=SCRAMBLE(J1,J2); 08268900
DO BEGIN DISKWAIT(-(D INX 30),SIXTY,J); 08268950
FOR I:=30 STEP 3 UNTIL 87 DO 08269000
IF (D[I] EQV A) = NOT 0 THEN 08269100
IF D[I+1].[CF]=1 THEN 08269200
BEGIN DISKWAIT(-D.[CF],-30,D[I+2].[CF]); 08269300
IF D[4].[1:3] ! 0 OR D[4].[6:1] 08269400
$ SET OMIT = NOT(RJE AND DATACOM ) 08269499
$ SET OMIT = NOT(PACKETS) 08269509
OR LABELTABLE[IF V=20 THEN 21 ELSE 08269510
IF V=21 THEN 20 ELSE 22].[6:24] 08269520
=D[I+1].[6:24] 08269530
$ POP OMIT 08269531
OR (D[4].[16:20] OR D[9].[1:28])!0 08269600
THEN 08269650
$ SET OMIT = NOT SHAREDISK 08269690
ELSE 08269750
BEGIN D[4].[6:1]:=1; 08269800
PBCOUNT:=PBCOUNT-1; 08269900
DISKWAIT(D.[CF],-30,D[I+2].[CF]);08270000
$ SET OMIT = NOT SHAREDISK 08270040
U:=18; 08270100
Q:=D[I+1]; 08270200
GO FOUND; 08270300
END END; 08270350
$ SET OMIT = NOT SHAREDISK 08270390
END UNTIL (J:=D[32].[FF])=0; 08270450
$ SET OMIT = NOT SHAREDISK 08270490
END; 08270550
FOUND: FORGETSPACE(D); 08270600
$ SET OMIT = SHAREDISK 08270640
UNLOCKDIRECTORY; 08270650
$ POP OMIT 08270660
END SEARCHING FOR DISK; 08270700
END; 08270725
% IF WE HAVE BOTH AN INPUT FILE AND AN OUTPUT UNIT, 08270740
% FIRE UP PRNPBT/DISK. 08270745
IF U!0 AND V!0 THEN 08270750
BEGIN 08270800
$ SET OMIT = NOT(DATACOM AND RJE ) 08270819
LABELTHEPRINTER; 08271000
FIREITUP: 08271750
A:=V&U[38:43:5]&PNCH[21:30:17]; 08272000
$ SET OMIT = NOT RJE 08272240
IF PNCH.[1:1] THEN P(A) ELSE 08272250
BEGIN 08272500
TRYAGAIN: 08272600
IF (HDR:=DIRECTORYSEARCH(P(PRNPBT),P(DISK),3)) ! 0 THEN 08272750
BEGIN 08273000
SHEAT := [M[F:=TYPEDSPACE(31,SHEETAREAV)]]&30[SIZE]; 08273250
M[F-1].[9:6] := 0; M[HDR INX NOT 1],[9:6]:=0; 08273260
MOVE(30,F-1,F); 08274500
SEG0 := TYPEDSPACE(30,SEGZEROAREAV);% %167-08275500
M[SEG0-2].[AREAMIXF] := 0;% %167-08275600
DISKWAIT(-SEG0, 30, M[HDR INX 10]); 08275750
F.[FF] := HDR; % CORE ADDRESS OF HEADER 08276000
SHEAT[7] := SEG0; % CORE ADDRESS OF SEGMENT ZERO 08276050
SHEAT[0] := P(PRNPBT); 08276100
SHEAT[1] := P(DISK); 08276150
SHEAT[2] := 0 & PRBPBTCODE[5:45:3] & 2[8:38:10] & 08276200
%PRIORITY=0.EXECUTE CODE 08276203
(PNCH.[2:1]=0)[4:47:1]; % SET IF NOT "PB" 08276205
SHEAT[16] := SHEAT[17] := @377777777777; % TIME LIMITS08276210
SHEAT[19] := A; % COMMON VALUE 08276220
SHEAT[20] := 4; % CORE ESTIMATE 08276230
SHEAT[21] := 150; % STACK SIZE 08276240
08276250
STREAM(A:=0: S:=P(.SCHEDULEIDS)); 08276260
BEGIN 08276270
SI:=S; 08276280
47(SKIP SB; SKIP DB; TALLY:=TALLY+1; 08276290
IF SB THEN ELSE JUMP OUT); 08276300
DS:=SET; A:=TALLY; 08276310
END STREAM STATEMENT; 08276320
08276330
I := P; 08276340
SHEAT[3].[8:10] := I; % SCHEDULE NUMBER 08276350
SHEAT[23] := (CLOCK + P(RTR)) DIV 60); 08276360
SHEAT[24] := MCP; %131-08276365
$ SET OMIT = NOT(DATACOM AND RJE) 08276370
SHEAT[25] := HDR.[FF]; % DISK ADDRESS OF FILE HEADER 08276400
STREAM(A, I:=I:=SPACE(11)); 08276410
BEGIN 08276420
DI:=DI+16; 08276430
DS:=30LIT"CC EXECUTE PRNPBT/DISK;COMMON="; 08276440
SI:=LOC A; DS:=8DEC; 08276450
DS:=6LIT";END.~"; 08276460
END STREAM STATEMENT; 08276470
M[I] := 0; M[I+1]:=10; 08276480
SHEAT[6] := GETESPDISK & 10[18:33:15]; 08276490
DISKWAIT(I, 11, SHEAT[6].[CF]); 08276500
FORGETSPACE(I); 08276510
INDEPENDENTRUNNER(P(.SELECTRUN),F,160); 08276520
P(1); 08276530
END ELSE % IF IN DIRECTORY 08276540
BEGIN 08276550
ENTERSYSFILE(3); 08276560
GO TRYAGAIN; 08276570
PRNPBT::: "PRNPBT "; 08276580
DISK::: "DISK "; 08276590
END; 08276600
END; 08277000
PRINTORPUNCHWIAT:=P; 08277500
END ELSE 08278000
08279000
QUIT: IF V NEQ 0 THEN 08280000
$ SET OMIT = NOT(RJE AND DATACOM ) 08280009
LABELTABLE[V]:=MULTITABLE[V]:=0; 08280030
END PRINTWAIT;% 08281000
PROCEDURE PRINTBACKUP(BUFF); VALUE BUFF; REAL BUFF; %P 08282000
% 08282100
% THIS PROCEDURE HANDLES THE PB MESSAGE, MAKING THE NECESSARY CHECKS 08282110
% AND THEN CALLING PRINTORPUNCHWIAT. THE SYNTAX OF THE MESSAGE IS: 08282120
% <PB MSG> ::= PB<INPUT FILE><PB SPECS> 08282140
% <INPUT FILE> ::= <TAPE UNIT> / <DISK FILE NUMBER> 08282150
% <PB SPECS> ::= <PB ELEMENT> / <PB ELEMENT><PB SPECS> / <EMPTY> 08282160
% <PB ELEMENT> ::= P / =<NUMBER OF COPIES> / #<STARTING FILE NUMBER>08282170
% 08282180
BEGIN REAL U,I,COPY,MS,STA,B=BUFF; 08283000
$ SET OMIT = NOT (DATACOM AND DCSPO) 08283400
LABEL OK,BAD,SPIT; 08284000
$ SET OMIT = NOT (DATACOM AND DCSPO) 08284450
STREAM(PCPY:=1, NUMB:=1, N:=1, CPY:=-0: B:=BUFF); 08285000
BEGIN SI~B; DI~LOC N; %P 08286000
L: IF SC=" " THEN BEGIN SI~SI+1; GO TO L END; %P 08287000
IF SC<"0" THEN BEGIN DS~5 LIT"+0000"; DS~3 CHR END ELSE%P 08288000
BEGIN B:=SI; 08289000
4(IF SC<"0" THEN JUMP OUT; TALLY~TALLY+1; SI~SI+1); 08289500
SI:=B; B:=TALLY; DI:=DI+5; DI:=DI-B; 08290000
DS~B CHR; %P 08290500
END; 08291000
LL: IF SC=" " THEN BEGIN SI:=SI+1; GO TO LL END; 08291025
IF SC="=" THEN BEGIN DI:=LOC CPY; GO TO CNT END; 08291050
IF SC="#" THEN 08291075
BEGIN DI:=LOC NUMB; 08291100
CNT: SI:=SI+1; B:=SI; IF SC=" " THEN GO TO CNT;TALLY:=0; 08291125
3(IF SC < "0" THEN JUMP OUT; 08291150
IF SC > "9" THEN JUMP OUT; 08291175
TALLY:=TALLY+1; SI:=SI+1); 08291200
SI:=B; B:=TALLY; DS:=8 OCT; 08291225
GO TO LL; 08291250
END; 08291275
IF SC="P" THEN 08291300
BEGIN TALLY:=0; PCPY:=TALLY; SI:=SI+1; 08291325
5(IF SC=ALPHA THEN IF SC<"0" THEN SI:=SI+1 ELSE 08291350
JUMP OUT ELSE JUMP OUT); 08291375
GO TO LL; 08291400
END; 08291425
END; 08291450
COPY:=(COPY:=P)&(NOT COPY = NOT 0)[31:47:1]; 08291460
% 08291470
% BACK UP TAPE. CHECK THE LABEL THEN CALL PRINTORPUNCHWAIT. 08291475
% 08291480
IF (U:=P) < 0 THEN 08291500
BEGIN COPY:=COPY&(P(XCH)-1)[32:40:8]; 08291750
IF NOT MTXIN(I,U,B) THEN 08292000
IF (STA:=MULTITABLE[U]!"PBTMCP " OR STA) AND 08292500
MULTITABLE[U]!"PUTMCP " THEN 08293000
BEGIN STREAM(BUFF); DS:=19 LIT" NOT A BACKUP TAPE~"; 08293500
GO TO SPIT; 08294000
END 08294500
ELSE 08295000
IF PRINTORPUNCHWAIT(-U, STA&COPY[30:31:17] OR M) THEN 08295200
GO TO OK ELSE BEGIN MS:=-1; GO TO BAD END 08295600
ELSE GO TO SPIT; 08295800
END; 08296000
% BACK UP DISK. SET FIRST REEL NUMBER. IF COPIES OR REEL NUMBER 08296160
% GIVEN, DISK IN "P" BIT, ELSE LEAVE IT OFF TO PRINT ENTIRE 08296170
% THING. CHECK FOR THE FILE, THEN CALL PRINTORPUNCHWAIT. 08296180
% 08296190
% 08296200
STREAM(I:=P: U:=[U]); 08296225
BEGIN SI:=LOC I; DI:=DI+5; 08296250
DS:=3 DEC; 08296275
END; 08296300
I:=P-1; 08296325
IF (COPY OR I).[CF]=0 THEN P(DEL) ELSE 08296350
COPY:=COPY&P(XCH)[39:47:1]; 08296375
BUFF:=BUFF.[15:15]-1; 08296400
IF (I:=DIRECTORYSEARCH("PBD ",U,5))=0 THEN 08296600
IF (I:=DIRECTORYSEARCH("PUD ",U,5))=0 THEN GO TO BAD 08296800
ELSE STA:=STA OR 1; 08297000
P(M[I+4]); 08297200
FORGETSPACE(I); 08297300
IF P.[2:1] THEN BEGIN MS:=2; GO TO BAD END; 08297400
IF PBCOUNT LSS 1 THEN PBCOUNT:=1; 08297600
IF PRINTORPUNCHWAIT(U, STA&COPY[30:31:17] OR M) THEN 08298000
OK: FORGETSPACE(BUFF) 08298200
ELSE 08298400
BEGIN MS:=1; 08298600
BAD: STREAM(MS, X:=MS<0, U:=IF P(DUP) THEN TINU[U] ELSE U, 08298800
BUFF:=BUFF.[CF]); 08299000
BEGIN DS:=8 LIT" NULL PB"; 08299200
SI:=LOC U; CI:=CI+X; GO TO DK; 08299400
SI:=SI+5; DS:=3 CHR; GO TO LL; 08299600
DK: SI:=SI+1; DS:=4 CHR; 08299800
BUFF:=DI; DI:=DI-4; DS:=3 FILL; DI:=BUFF; 08300000
LL: DS:=2 LIT"-("; 08300200
CI:=CI+MS; GO TO L0; GO TO L1; 08300400
DS:= 6 LIT"IN USE"; GO TO L; 08300600
L1: DS:=14 LIT"NO OUTPUT UNIT"; GO TO L; 08300800
L0: DS:=11 LIT"NOT ON DISK"; 08301000
L : DS:= 2 LIT")~"; 08301200
END; 08301400
SPIT: SPOUT(BUFF 08301600
$ SET OMIT = NOT (DATACOM AND DCSPO) 08301650
); 08301800
END; 08302000
END OF PB KEYBOARD MESSAGE HANDLER; 08302500
SAVE PROCEDURE INITIALIZE; FORWARD; 08303000
REAL ACTDATE=INITIALIZE; 08303100
SAVE REAL PROCEDURE COREND; FORWARD; 08303200
REAL WEEKDAY=COREND; 08303300
PROCEDURE TIMEOUT (B); VALUE B; REAL B;% 08305000
BEGIN INTEGER M,H,C;% 08306000
C ~XCLOCK/3600;% 08307000
M ~ C MOD 60;% 08308000
H ~ C DIV 60;% 08309000
STREAM(H,M,B);% 08310000
BEGIN DS ~ 9 LIT " TIME IS ";% 08311000
SI ~ LOC H; DS ~ 2 DEC; DS ~ 2 DEC;% 08312000
DS ~ LIT "~"% 08313000
END;% 08314000
SPOUT(B INX MEMORY[B-1]); 08315000
END;% 08316000
PROCEDURE GIMEDATE(B,DT); VALUE B,DT; REAL B,DT; 08317000
%% PARAMETER USE IS: 08317100
%% B=OUTPUT AREA FOR MESSAGE OR DATE 08317200
%%DT=0 RECONVERT ACTDATE,WEEKDAY THEN SPOUT TIME MSG 08317300
%% DT>0 SPOUT TIME MSG ONLY 08317400
%% DT<0 CONVERT MMDDYY USING DT (ACTDATE,WEEKDAY NOT CHANGED) 08317500
BEGIN REAL M,D,Y,NCV,NMG; 08318000
REAL SUBROUTINE DAY; 08318100
BEGIN;STREAM(M:X~0,Y~0,Z~0); 08318200
BEGIN DI~LOC X; DS~24 LIT"000~0%1.1Y2G2V3D3T4A4 5>";08318300
DI~LOC X; SI~SI+M; SI~SI+M; 08318400
DI~LOC M; DI~DI+6; DS~2 CHR; 08318500
END; 08318600
DAY~P; 08318700
END DAY; 08318800
LABEL DAYS; 08318900
LABEL ON;;% 08319000
IF NOT (NCV~(DT>0)) THEN % NOT PRINT ONLY 08319700
BEGIN 08319900
STREAM(DATE~IF (NMG~DT.[1:1]) THEN DT ELSE DATE,R~[Y]); 08320000
BEGIN SI ~ LOC DATE; SI ~ SI+3;% 08321000
DS~2 OCT; DI~DI-16; DS~3 OCT; 08322000
END;% 08323000
IF Y MOD 4 = 0 AND Y ! 0 THEN% 08324000
BEGIN IF D = 60 THEN% 08325000
BEGIN M~2; GO ON END; 08326000
IF D > 60 THEN D ~D-1;% 08327000
END;% 08328000
FOR M~1 STEP 1 UNTIL 11 DO 08329000
IF DAY}D THEN GO ON; 08330000
ON: M~M-1; 08331000
D~D-DAY; 08332000
IF M<2 THEN P(Y-1,M+11) ELSE P(Y,M-1); 08332100
P(26,|,2,-,10,IDV,D,+,XCH,P(DUP).[36:10],+,+,7,RDV,5,ISN);08332200
:: P(.DAYS,+,LOD); 08332300
M~M+1; 08332400
END ELSE P(WEEKDAY); 08332500
STREAM(M~[M],NMG,NCV,MDY~[ACTDATE],B,DATE,DW~[WEEKDAY]); 08333000
BEGIN NMG(JUMP OUT TO NOMSG); 08334000
SI~LOC M; SI~SI-16; 08334100
NCV(SI~SI+2; JUMP OUT TO NOCNV); 08334300
DS~WDS; SI~SI-6; 08334500
NOCNV: DI~B; DS~9 LIT" DATE IS "; DS~6 CHR; 08334700
DS~5 LIT"DAY, "; B~DI; NCV(JUMP OUT TO NULCV); 08334900
NOMSG: SI~M; NMG(DI~B; JUMP OUT TO NULMS); 08335000
DI~MDY; 08335200
NULMS: DS~4 DEC; DS~2 DEC; DS~2 DEC; 08335400
NMG(JUMP OUT TO OXIT); DI~B; 08335600
NULCV: SI~MDY; SI~SI+2; 08335800
DS~2 CHR; 2(DS~LIT "/"; DS~2 CHR); 08336000
DS:=2 LIT"-("; SI:=LOC DATE; 08336500
SI:=SI+3; DS:=5 CHR; DS:=2 LIT")~"; 08337000
SI:=B; 08337500
3(DI ~ B; DS ~ FILL; SI ~ SI+3; B ~SI);% 08338000
OXIT: END; 08339000
IF DT}0 THEN 08339500
IF NOT NMG THEN SPOUT(B INX MEMORY[B-1]); 08340000
P(XIT); 08340100
DAYS::: " MON"," TUES","WEDNES"," THURS"," FRI"," SATUR", 08340200
" SUN"; 08340300
END;% 08341000
DEFINE DATEOUT(DATEOUT1)=GIMEDATE(DATEOUT1,0)#; %CHANGE DATE & SPOUT IT 08342000
PROCEDURE SETDATE(BUFF); VALUE BUFF; REAL BUFF;% 08343000
BEGIN REAL DY,MN,YR; INTEGER D=DY; REAL B,T=MN; 08344000
REAL SUBROUTINE C; 08344100
BEGIN;STREAM(C~0:B~[B]); 08344200
BEGIN% 08345000
SI ~ B; SI ~ SI+5; SI ~ SC;% 08346000
L: IF SC < "0" THEN% 08347000
BEGIN IF SC = "~" THEN GO TO X;% 08348000
SI ~ SI+1; GO TO L;% 08349000
END;% 08350000
K: IF SC } "0" THEN% 08351000
BEGIN TALLY ~ TALLY+1;% 08352000
SI ~ SI+1; GO TO K END;% 08353000
DI ~ B; B ~ SI; SI ~ LOC B; DS ~ WDS;% 08354000
SI ~ B; B ~ TALLY; DI ~ LOC C;% 08355000
SI ~ SI-B; DS ~ B OCT;% 08356000
X:END;% 08357000
C~P;% 08358000
END C; 08358100
B ~ BUFF;% 08359000
MN~C; DY~C; YR~C;% 08360000
BUFF ~ BUFF.[15:15]-1;% 08361000
IF MN > 0 AND MN { 12 AND% 08362000
DY > 0 AND DY { 31 AND% 08363000
YR > 0 THEN% 08364000
BEGIN;STREAM(M~MN-1:X~0,Y~0,Z~0); 08365000
BEGIN DI~LOC X; DS~24 LIT"000~0%1.1Y2G2V3D3T4A4 5>";08365100
SI~LOC X; SI~SI+M; SI~SI+M; 08365200
DI~LOC M; DI~DI+6; DS~2 CHR; 08365300
END; 08365400
DY~P+DY; 08366000
IF YR MOD 4 = 0 AND MN > 2 AND(YR MOD 100 ! 0 OR% 08367000
YR MOD 400 = 0) THEN% 08368000
DY ~ DY+1;% 08369000
D ~ YR MOD 100 | 1000+DY;% 08370000
STREAM(D,A~[DATE]);% 08371000
BEGIN SI ~ LOC D; DS ~ 8 DEC END;% 08372000
CHANGEDATE(BUFF);% 08373000
END ELSE SPOUT(BUFF INX MEMORY[BUFF -1]); 08374000
END;% 08375000
PROCEDURE CHANGEDATE(BUFF); VALUE BUFF; REAL BUFF;% 08376000
BEGIN REAL B,C,D,T;% 08377000
SLEEP([TOGLE],HOLDMASK); 08378000
LOCKTOG(HOLDMASK); 08379000
B ~ SPACE(30);% 08380000
DISKWAIT(-B,-30,DIRECTORYTOP); 08381000
D:= M[B+1];% 08381100
M[B+1] ~ DATE;% 08383000
M[B+18]:=XCLOCK; 08383100
DISKIO(T,B-1,-30,DIRECTORYTOP); 08384000
IF BUFF!0 THEN 08384100
BEGIN% 08384200
DATEOUT (BUFF);% 08385000
C := TYPEDSPACE(5,MAINTBUFFAREAV);% %167-08385100
M[C ]:= M[C+2]:= 0;% 08385200
M[C+3]:= D;% 08385300
STREAM(DATE,A:=C+1); BEGIN SI:=LOC DATE; DS:=8 OCT; END;% 08385400
LINKUP(17,C);% 08385500
END;% 08385600
SLEEP([T],IOMASK);% 08386000
FORGETSPACE(B);% 08387000
UNLOCKTOG(HOLDMASK); 08388000
END;% 08389000
PROCEDURE SETIME(BUFF); VALUE BUFF; REAL BUFF;% 08390000
BEGIN REAL B=BUFF,T;% 08391000
REAL I,R;% 08392000
LABEL EXIT;% 08393000
REAL CLOCK=XCLOCK;% 08394000
INTEGER CLCK=CLOCK;;% 08395000
T ~ -1;% 08396000
STREAM(B,T~[T]);% 08397000
BEGIN SI ~ B;% 08398000
L: IF SC = " " THEN% 08399000
BEGIN SI ~ SI+1; GO TO L END;% 08400000
IF SC < "0" THEN GO TO X;% 08401000
K: IF SC } "0" THEN% 08402000
BEGIN SI ~ SI+1; TALLY ~ TALLY+1;% 08403000
GO TO K END;% 08404000
B ~ TALLY; SI ~ SI-B; DS ~ B OCT;% 08405000
X:% 08406000
END;% 08407000
BUFF ~ BUFF.[15:15]-1;% 08408000
IF T } 0 AND T DIV 100 < 24 AND T MOD 100 < 60 THEN% 08409000
BEGIN R := TYPEDSPACE(5,MAINTBUFFAREAV);% %167-08410000
M[R+2]:= XCLOCK;% 08410100
CLCK:= (T DIV 100 | 60 + T MOD 100)|3600;% 08410200
CLOCK ~ (CLOCK OR @77)+1;% 08411000
TIMEOUT (BUFF);% 08412000
M[R]:= M[R+3]:= 0;% 08412100
STREAM(DATE,A:=R+1);% 08412200
BEGIN SI:=LOC DATE; DS:=8 OCT; END;% 08412300
LINKUP(17,R);% 08412400
GO TO EXIT;% 08413000
END;% 08414000
SPOUT(BUFF INX MEMORY[BUFF-1]); 08415000
EXIT:% 08416000
END;% 08417000
REAL PROCEDURE FORMESS(BUFF,H1); VALUE BUFF,H1; REAL BUFF,H1; 08418000
BEGIN REAL B,H,U,M1; 08418500
INTEGER I; 08418700
LABEL AGAIN,EXIT,AWAY; 08419000
M1:=M[BUFF.[15:15]-2]; 08419100
STREAM(BUFF:); 08419200
BEGIN SI:=BUFF; 08419300
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 08419400
BUFF:=SI; 08419500
END; 08419600
BUFF:=P; 08419700
AGAIN: U:=FORMESS:=UNITIN(TINU,BUFF); 08420000
IF U{31 THEN BEGIN SLEEP([TOGLE],STATUSMASK); 08421000
IF LABELTABLE[U] < 0 THEN% 08422000
BEGIN STREAM(A:=TINU[U],B:=B:=SPACE(5)); 08424000
BEGIN SI ~ LOC A; SI ~ SI + 5; DS ~ 3 CHR;% 08425000
DS:=24LIT" IN USE(TO BE READIED)~"; 08426000
END;% 08427000
SAVEWORD := SAVEWORD AND NOT TWO(U); 08427100
SPOUT(B); 08428000
IF H1 THEN GO AWAY ELSE GO TO EXIT; 08429000
END; 08429500
LABELTABLE[U]:=@114&H1[1:47:1]; 08430000
MULTITABLE[U] ~ 0;% 08431000
I ~ TWO(U);% 08432000
IF H1 THEN B:=NOT 0 ELSE 08433000
BEGIN B:=NOT I; H:=I:=0; 08434000
IF U=23 THEN H:=P(.READERA); 08434100
IF U=24 THEN H:=P(.READERB); 08434200
IF H!0 THEN 08434300
BEGIN UNITCODE[U-23]:=-0; 08434400
IF (*H).[CF]!0 THEN 08434500
BEGIN FORGETSPACE(*H-2); 08434600
M[H]:=0; 08434700
END; 08434800
END; 08434900
END; 08434950
READY ~ READY AND B OR I;% 08435000
RRRMECH ~ RRRMECH AND B OR I;% 08436000
SAVEWORD ~ SAVEWORD AND B OR I;% 08437000
END; 08437050
EXIT: IF NOT H1 THEN 08437100
BEGIN IF U GTR 31 THEN 08437150
BEGIN STREAM(BUFF,B:=B:=SPACE(5)); 08437200
BEGIN DS:=10 LIT"INV KBD RY"; 08437250
SI:=BUFF; DS:=3 CHR; 08437300
DS:=LIT"~"; 08437350
END; 08437400
SPOUT(B INX M1); 08437450
END; 08437500
STREAM(OK:=0,BUFF:); 08437550
BEGIN SI:=BUFF; 08437600
3(IF SC=" " THEN JUMP OUT; 08437650
IF SC="," THEN JUMP OUT; 08437700
IF SC="~" THEN JUMP OUT TO L3; 08437750
SI:=SI+1); 08437800
L1: IF SC=" " THEN 08437850
L2: BEGIN SI:=SI+1; GO TO L1 END; 08437900
IF SC="," THEN GO TO L2; 08437950
BUFF:=SI; 08438000
IF SC!"~" THEN TALLY:=1; 08438050
L3: OK:=TALLY; 08438100
END; 08438150
BUFF:=P; 08438200
IF P THEN GO AGAIN; 08438250
AWAY: FORMESS:=-1; 08438300
END; 08438350
I:=SPACE(30); %146-08438400
DISKWAIT(-I,30,DIRECTORYTOP-SYSNO); %146-08438410
M[I+29]:=SAVEWORD; %146-08438420
DISKWAIT( I,30,DIRECTORYTOP-SYSNO); %146-08438430
FORGETSPACE(I); %146-08438440
END; 08438500
PROCEDURE SUSTATUS(A,DDD,B); VALUE A,DDD,B; REAL A,B; ARRAY DDD[*]; 08438900
FORWARD; 08438910
PROCEDURE OUTPUTLABEL(B); VALUE B; REAL B;% 08439000
BEGIN REAL BU=B,U,T,A;% 08440000
REAL G,Q;% 08441000
REAL TUSTA,TEMP; 08441050
BOOLEAN SCHTOG; 08441100
LABEL EXIT;% 08442000
SUBROUTINE DOIT;% 08443000
BEGIN; STREAM(A~TINU[U]:B);% 08444000
BEGIN SI ~ LOC A; SI ~ SI+5; DS ~ LIT" ";% 08445000
DS ! 3 CHR; DS ~ LIT " "; A ~ DI END;% 08446000
A ~ P; T ~ LABELTABLE[U];% 08447000
IF U LSS 16 THEN TEMP:=PRNTABLE[U].[30:18]; 08447100
IF T=0 THEN 08448000
STREAM(B:=TEMP,V:=(U LSS 16),A); 08448050
BEGIN SI:=LOC V;SI:=SI+7; 08448100
IF SC NEQ "0" THEN BEGIN SI:=LOC B;DS:=5DEC END; 08448110
DS:=9LIT" SCRATCH~" END 08448150
ELSE IF T = @114 OR T = @214 THEN% 08449000
BEGIN 08450000
STREAM(SAV:=((TWO)U) AND SAVEWORD) NEQ 0),A); 08450100
BEGIN 08450200
DS:=10LIT"NOT READY~"; 08450300
SAV(DI:=DI-1; DS:=8LIT"(SAVED)~"); 08450400
END 08450500
END 08450600
ELSE IF ABS(T)=@314 THEN 08451000
STREAM(B:=TEMP,V:=(U LSS 16),A); 08451100
BEGIN SI:=LOC V; SI:=SI+7; 08451200
IF SC NEQ "0" THEN BEGIN SI:=LOC B;DS:=5DEC END; 08451210
DS:=11 LIT " UNLABELED~"; 08452000
END 08452100
ELSE BEGIN;% 08453000
STREAM(K:=T<0: TEMP, V:=U<16, A); 08454000
BEGIN V(SI:=LOC TEMP; DS:=5 DEC; DS:=LIT" "); 08454500
CI:=CI+K; GO TO LAB; 08455000
DS:=6 LIT"IN USE"; GO TO L; 08455500
LAB: DS:=7 LIT"LABELED"; 08456000
L: DS:=LIT" "; K:=DI; 08457000
END; 08458000
A ~ P;% 08459000
IF (NT1 ~ RDCTABLE[U].[8:6]) ! 0 THEN% 08460000
IF JARROW[NT1] ! 0 THEN% 08461000
BEGIN;STREAM(J~JARROW[NT1]:NT1,A);% 08462000
BEGIN DS ~ 3 LIT "BY "; SI ~ J;% 08463000
SI ~ SI+1; DS ~ 7 CHR;% 08464000
DS ~ LIT "/"; SI ~ SI+1;% 08465000
DS ~ 7 CHR; DS ~ LIT "=";% 08466000
SI~LOC NT1; DS~2DEC; 08467000
DS ~ LIT ":"; J ~ DI;% 08468000
DI~DI-3; DS~FILL; 08468500
END;% 08469000
A ~ P;% 08470000
END ELSE ELSE 08471000
IF T<0 AND (U=23 OR U=24) THEN 08471010
BEGIN 08471020
STREAM(S:=0 : A); 08471030
BEGIN 08471040
DS:=22LIT"BY AUTO LOAD CONTROL: "; 08471050
S:=DI; 08471060
END; 08471070
A:=P; 08471080
END ELSE 08471090
IF U GEQ 20 AND U LEQ 22 THEN 08471100
IF LABELTABLE[U].[1:5]=@21 THEN 08471105
BEGIN STREAM(S:=0,A); 08471110
BEGIN 08471120
DS:=13 LIT "BY SCHEDULED "; 08471130
DS:=13 LIT "PRNPBT/DISK: "; 08471140
S:=DI; 08471150
END; 08471160
A:=P; 08471170
END; 08471180
STREAM(S~0:K~MULTITABLE[U],T,R~RDCTABLE[U]. 08472000
[14:10],D~RDCTABLE[U].[24:17],C~RDCTABLE[U].% 08473000
[41:7],A); BEGIN SI ~ LOC K;% 08474000
2(SI ~ SI+1; DS ~ 7 CHR; DS ~ LIT " ");% 08475000
DS ~ 3 DEC; DS ~ LIT " ";% 08476000
DS ~ 5 DEC; DS ~ LIT " ";% 08477000
DS ~ 2 DEC; DS ~ LIT "~";% 08478000
S~DI; 08478500
END; 08478600
A~P; 08478700
IF U}32 THEN IF CIDROW[U -32]!0 THEN 08478800
STREAM(DK~CIDTABLE[U -32,2],A); 08478900
BEGIN 08479000
DI~DI-1; 08479100
$ SET OMIT = NOT(PACKETS) 08479109
DS:=5 LIT ",PKT "; 08479110
$ POP OMIT 08479111
$ SET OMIT = PACKETS 08479199
SI~LOC DK; SI~SI+1; 08479300
DS~7 CHR; 08479400
END; 08479500
END; 08479600
SPOUT(B INX TUSTA); 08480000
B ~ 0;% 08481000
END;% 08482000
TUSTA~M[B.[15:15]-2]; 08482050
IF (U ~ UNITIN(TINU,B)){ PSEUDOMAXT THEN 08483000
BEGIN B ~ B.[15:15]-1;% 08484000
IF (U OR 1)=19 THEN SUSTATUS(B INX TUSTA,0,U) ELSE 08484500
DOIT;% 08485000
GO TO EXIT;% 08486000
END;% 08487000
$ SET OMIT = SHAREDISK 08487099
SCRTOG ~ U = PSEUDOMAXT + 1; 08487100
$ POP OMIT 08487101
$ SET OMIT = NOT(SHAREDISK) 08487199
STREAM(A~0:B);% 08488000
BEGIN SI ~ B;% 08489000
L: IF SC = " " THEN% 08490000
BEGIN SI ~ SI+1; GO TO L END;% 08491000
DI ~ LOC A; DI ~ DI+6; DS ~ 2 CHR;% 08492000
END;% 08493000
Q ~ P; B ~ B.[15:15]-1;% 08494000
FOR U ~ 0 STEP 1 UNTIL PSEUDOMAXT DO 08495000
IF TINU[U].[30:12] = Q THEN% 08496000
IF (G ~ LABELTABLE[U])!0 AND G!@114 AND G!@214 08497000
AND NOT SCRTOG OR G=0 AND SCRTOG THEN 08497100
BEGIN IF B = 0 THEN B ~ SPACE(10);% 08498000
DOIT;% 08499000
END;% 08500000
IF B ! 0 THEN% 08501000
BEGIN;STREAM(Q,R);% 08502000
BEGIN DS ~ 6 LIT " NULL ";% 08503000
SI ~ LOC Q; SI ~ SI+6; DS ~ 2 CHR;% 08504000
DS ~ 7 LIT " TABLE~";% 08505000
END;% 08506000
SPOUT(B INX TUSTA); 08507000
END;% 08508000
EXIT: END;% 08509000
PROCEDURE TIMEUSED(B, X); 08525000
VALUE B, X; 08526000
REAL B, X; 08527000
BEGIN INTEGER T, H, M, S, CPT, IOT, ET; 08528000
$ SET OMIT = NOT(PACKETS) 08528499
DEFINE UNITNO = PSEUDOMIX[X]#; 08528500
$ POP OMIT 08528501
REAL SUBROUTINE CONVERTIME; 08529000
BEGIN S ~ T-60|(T ~ T DIV 60); 08530000
M ~ T-60|(H ~ T DIV 60); 08531000
STREAM(R~0: A~[H]); 08532000
BEGIN DI~LOC R; DI~DI+2; SI~A; 3(DS~2 DEC) END; 08533000
CONVERTIME ~ POLISH 08533100
END; 08533200
T ~ JAR[X,3]+PROCTIME[X]; 08533400
$ SET OMIT = NEWLOGGING 08533499
IF X=P2MIX OR X=P1MIX THEN 08533500
$ POP OMIT 08533501
$ SET OMIT = NOT(NEWLOGGING) 08533599
T ! T+CLOCK+P(RTR); 08533700
T ~ T/60; CPT ~ CONVERTIME; 08534000
T ~ JAR[X,4]+IOTIME[X]; 08535000
WHILE T<0 DO T ~ T+CLOCK+P(RTR); 08536000
T ~ T/60; IOT ~ CONVERTIME; 08537000
T ~ ((CLOCK+P(RTR))/60)-NFO[(X-1)|NDX+2].[1:17]; 08538000
ET ~ CONVERTIME; 08538500
STREAM(J~JARROW[X],X,T~[CPT],B); 08540000
BEGIN DS~10 LIT " TIME FOR "; SI~J; SI~SI+1; DS~7 CHR; 08540100
SI~SI+1; DS~LIT "/"; DS~7 CHR; DS~LIT"="; 08540200
SI~LOC X; DS~2 DEC; X~DI; DI~DI-2; DS~FILL; 08540300
DI~X; DS~8 LIT " IS: CP="; SI~T; SI~SI+2; 08541000
3(DS~LIT ":"; DS~2 CHR); 08542000
X~DI; DI~DI-9; DS~8 FILL; DI~X; 08543000
DS~5 LIT ", IO="; SI~SI+2; 08544000
3(DS~LIT ":"; DS~2 CHR); 08544100
X~DI; DI~DI-9; DS~8 FILL; DI~X; 08544200
DS~3 LIT " IN"; SI~SI+2; 08544300
3(DS~LIT ":"; DS~2 CHR); DS~LIT "~"; 08544400
DI~DI-10; DS~8 FILL 08544500
END; 08544600
SPOUTER(B INX MEMORY[B-1],UNITNO,1); 08544700
COMMENT MESSAGE PRESENTLY 72 CHARACTERS LONG; 08544800
END; 08545000
REAL PROCEDURE ANVIL(IL,Z); VALUE IL,Z; REAL IL,Z;% 08546000
BEGIN REAL B=Z,U=+1;% 08547000
REAL ZZ; 08547050
LABEL EXIT; 08547100
ZZ:=Z; 08547200
NAMEID(U,ZZ); 08547300
NAMEID(U,ZZ); 08547400
IF U="/ " THEN 08547500
BEGIN U:=Z.[15:15]; GO EXIT END ELSE 08547600
IF (U ~ UNITIN(TINU,B)) { PSEUDOMAXT THEN 08548000
BEGIN% 08549000
IF LABELTABLE[U] = @114 OR LABELTABLE[U] = @214 THEN% 08550000
BEGIN 08551000
STREAM(A:=TINU[U],SAV:=((TWO(U) AND SAVEWORD) ! 0 ), 08551100
X:=Z.[15:15]-1); 08551200
BEGIN 08551300
SI:=LOC A; SI:=SI+5; DS:=3CHR; 08552000
DS:=11LIT" NOT READY~"; 08553000
SAV(DI:=DI-1; DS:=8LIT"(SAVED)~"); 08554000
END; 08554100
U ~ PSEUDOMAXT + 1; 08555000
END ELSE 08556000
IF LABELTABLE[U] < 0 THEN% 08557000
BEGIN;STREAM(A~TINU[U],X~Z.[15:15]-1);% 08558000
BEGIN SI ~ LOC A; SI ~ SI+5;% 08559000
DS ~ 3 CHR; DS ~ 8 LIT " IN USE~";% 08560000
END;% 08561000
U ~ PSEUDOMAXT + 1; 08562000
END;% 08563000
IF U { PSEUDOMAXT THEN 08564000
LABELTABLE[U] ~ -(IF IL THEN *P(DUP) ELSE @314);% 08565000
EXIT: END; END; 08566000
PROCEDURE LOGOUT(A); VALUE A; REAL A; 08568000
BEGIN REAL RCW=+0; 08568100
REAL MSCW=-2; 08568125
INTEGER I=RCW+1; 08568150
REAL J=I+1, L=J+1; % L MUST BE LAST DECLARATION. 08568200
LABEL EXIT; 08568300
P(0,0,SPACE(335)); % INITIALIZES L 08568600
IF (J:=DIRECTORYSEARCH("SYSTEM ","LOG ",4))=0 THEN 08568700
BEGIN; 08568800
STREAM(L); 08568900
BEGIN DS:=10 LIT "-NULL LOG~" END; 08569000
GO TO EXIT; 08569100
END; 08569200
IF LOGFREE GTR 0 THEN SLEEP([LOGFREE],-0); 08569300
LOGFREE:=ABS(LOGFREE); 08569400
$ SET OMIT = NOT(SHAREDISK) 08569499
MOVE(30,J INX 0,L); 08569600
M[L+10] ~ GETUSERDISK(-(M[L+8]~M[L+8]+10)); % GET XTRA TEN 08569700
DO BEGIN % TO MAKE COPY 08569800
DISKWAIT (-L-31,300,M[J+10]+I); % SIMPLER 08569900
DISKWAIT ( L+31,300,M[L+10]+I); 08569910
END UNTIL (I~I+10)}M[J+8]; 08569920
LOGFREE ~ M[J+10]; 08570000
J:=J INX 0; 08570300
M[J]:=M[J+2]:=M[J+3]:=0; 08570400
M[J+1]:=M[J+8]|6; 08570500
M[J+4]:="DISKLOG"; 08570600
M[J+5]:=4; 08570700
DISKWAIT(J,30,LOGFREE); 08570800
$ SET OMIT = NOT(SHAREDISK) 08570849
LOGFREE~NABS(LOGFREE); 08570870
P(DIRECTORYSEARCH(-"SYSTEM ","LOG ",14),DEL); 08570880
IF HOLDFREE=0 THEN SLEEP([TOGLE],HOLDMASK); 08571000
LOCKTOG(HOLDMASK); 08571100
DISKWAIT(-J,-30,DIRECTORYTOP); 08571200
I:=(M[J+20].[8:10]+1) MOD 1000; 08571300
M[J+20]:=(*P(DUP))&I[8:38:10]; 08571400
DISKWAIT(J,-30,DIRECTORYTOP); 08571500
UNLOCKTOG(HOLDMASK); 08571600
STREAM(J~[ACTDATE],D~[I]); 08571800
BEGIN SI:=D;DS:=8 DEC;DI:=DI-7;SI:=J; 08571900
SI~SI+2; DS~4 CHR; 08572000
END; 08572300
FORGETSPACE(J); 08572400
M[L+4]:=(*P(DUP))&0[1:43:5]&1[11:47:1]&0[12:44:4]; 08572500
M[L+1]~XCLOCK+P(RTR); 08572510
STREAM(DATE,A~0,B~L+1); 08572520
BEGIN SI~ LOC DATE;DI~LOC A;DS~8 OCT;SI~LOC A; 08572530
SI~SI+5;DI~B;DI~DI+1;DS~3 CHR; END; 08572540
ENTERUSERFILE(-I,"SYSLOG ",L-1); 08572600
STREAM(I,L); 08572700
BEGIN DS:=21 LIT"**** NEW LOG FILE IS ";SI:=LOC I;SI:=SI+1; 08572800
DS:=7 CHR;DS:=8 LIT"/SYSLOG~" ; 08572900
END; 08573000
EXIT: 08573100
SPOUT(L); 08573200
IF A THEN KILL([MSCW]); 08573300
END; 08573400
PROCEDURE SAVETHEUNIT(B); VALUE B; REAL B;% 08575000
BEGIN REAL A=B,T,U,I,M1; 08576000
LABEL AGAIN,EXIT; 08576100
M1:=M[B.[15:15]-2]; 08577000
STREAM(B:); 08577100
BEGIN SI:=B; 08577200
L: IF SC=" " THEN BEGIN SI:=SI+1; GO TO L END; 08577300
B:=SI; 08577400
END; 08577500
B:=P; 08577600
AGAIN: T:=SPACE(10); 08577700
IF (U:=UNITIN(TINU,A)) GTR 31 THEN 08578000
STREAM(A,T); 08578100
BEGIN DS:=10 LIT"INV KBD SV"; 08578200
SI:=A; DS:=3 CHR; 08578300
DS:=LIT"~"; 08578400
END ELSE 08578500
BEGIN I ~ TWO(U);% 08579000
SLEEP([TOGLE],STATUSMASK); 08580000
IF LABELTABLE[U] } 0 THEN% 08581000
BEGIN LABELTABLE[U] ~ @114;% 08582000
MULTITABLE[U]~RDCTABLE[U]~0; 08582100
RRRMECH ~ RRRMECH OR I;% 08583000
READY ~ READY OR I;% 08584000
SAVEWORD := SAVEWORD OR I; 08584100
I ~ " ";% 08585000
END% 08586000
ELSE BEGIN SAVEWORD ~ SAVEWORD OR I;% 08587000
I ~ " TO BE";% 08588000
END;% 08589000
STREAM(A~TINU[U],I,T);% 08590000
BEGIN DS ~ LIT " ";% 08591000
SI ~ LOC A; SI ~ SI+5; DS ~ 3 CHR;% 08592000
SI ~ SI+2; DS ~ 6 CHR;% 08593000
DS ~ 7 LIT " SAVED~";% 08594000
END;% 08595000
END;% 08596000
SPOUT(T INX M1); 08597000
STREAM(OK:=0,A:); 08597050
BEGIN SI:=A; 08597100
3(IF SC=" " THEN JUMP OUT; 08597150
IF SC="," THEN JUMP OUT; 08597200
IF SC="~" THEN JUMP OUT OT L3; 08597250
SI:=SI+1); 08597300
L1: IF SC=" " THEN 08597350
L2: BEGIN SI:=SI+1; GO TO L1 END; 08597400
IF SC="," THEN GO TO L2; 08597450
A:=SI; 08597500
IF SC!"~" THEN TALLY:=1; 08597550
L3: OK:=TALLY; 08597600
END; 08597650
A:=P; 08597700
IF P THEN GO AGAIN; 08597750
T:=SPACE(30); %146-08597800
DISKWAIT(-1,30,DIRECTORYTOP-SYSNO); %146-08597810
M[T+29]:=SAVEWORD; %146-08597820
DISKWAIT( T,30,DIRECTORYTOP-SYSNO); %146-08597830
FORGETSPACE(T); %146-08597840
END;% 08598000
BOOLEAN PROCEDURE WHYSLEEP(MASK); VALUE MASK; REAL MASK; 08599000
BEGIN 08600000
REAL A, B; 08601000
IF REPLY[P1MIX]=VWY THEN 08602000
BEGIN 08603000
B:=SPACE(KEYMSGSZ); 08604000
DISKWAIT(-B,KEYMSGSZ,MESSAGETABLE[2].[22:26]); 08604100
STREAM(B,MASK,T:=0,O:=0,D:=0,A:=A:=SPACE(4)); 08605000
BEGIN 08606000
SI:=LOC MASK; 08607000
8(IF SC="0" THEN GO TO NEXT; 08608000
IF SC=VWY THEN 08609000
BEGIN 08610000
DI:=A; DS:=3LIT" DS"; A:=DI; GO TO NEXT; 08611000
END; 08612000
T:=SI; DI:=LOC 0; DI:=DI+7; DS:=CHR; 08613000
SI:=LOC O; DI:=LOC D; DI:=DI+6; DS:=2DEC; 08614000
SI:=B; 08615000
R: SI:=SI+6; DI:=DI-2; 08616000
IF SC="*" THEN % END OF FIRST PART OF TABLE 08617000
BEGIN 08617500
SI:=T; GO TO NEXT; 08618000
END; 08618500
IF 2SC NEQ DC THEN GO TO R; 08619000
SI:=SI-6; DI:=A; DS:=LIT" "; DS:=2CHR; A:=DI; SI:=T; 08619500
NEXT: SI:=SI+1); 08620000
DI:=A; DS:=LIT"~"; 08620500
END STREAM STATEMENT; 08621000
SPOUT(A); 08621500
FORGETSPACE(B); 08621600
END % IF "WY" 08622000
ELSE WHYSLEEP:=TRUE; 08622500
END PROCEDURE WHYSLEEP; 08623000
PROCEDURE CHANGEOPTION(BUFF,RS);% 08624000
VALUE BUFF,RS;REAL BUFF,RS;% 08625000
BEGIN REAL B,T,OP,BUS,MASK,OPTER; 08626000
SLEEP([TOGLE],HOLDMASK); 08627000
LOCKTOG(HOLDMASK); 08628000
BUS ~ BUFF.[15:15]-1; B ~ SPACE(30);% 08629000
DISKIO(T,1-B,-30,DIRECTORYTOP-SYSNO); 08630000
OPTER ~ SPACE(OPTIONSZ); 08630100
DISKWAIT(-OPTER,OPTIONSZ,MESSAGETABLE[0].[22:26]); 08631000
STREAM(BUFF,T~0,OPTER,R~[OP]);% 08632000
BEGIN% 08633000
L0: SI~BUFF; %535-08634000
L1: IF SC=" " THEN BEGIN SI~SI+1; GO TO L1; END; %535-08635000
IF SC<"0" THEN %535-08636000
IF SC!"~" THEN %535-08637000
BEGIN TALLY~0; T~TALLY; DI~LOC T; %535-08638000
8(IF SC=" " THEN JUMP OUT ELSE %535-08639000
IF SC="~" THEN JUMP OUT ELSE %535-08640000
IF SC}"0" THEN JUMP OUT ELSE DS ~CHR); %535-08641000
BUFF~SI; SI~OPTER; %535-08642000
63(DI~LOC T; %535-08643000
IF 8 SC=DC THEDN JUMP OUT TO L2 ELSE %535-08644000
IF SC="~" THEN JUMP OUT TO L0 ELSE TALLY~TALLY+1);08645000
GO TO L3; %535-08646000
L2: IF SC="~" THEN GO TO L0; %535-08647000
END ELSE %535-08648000
L3: TALLY~48 ELSE %535-08649000
BEGIN DI~LOC T; SI~SI+1; %535-08650000
IF SC<"0" THEN BEGIN SI~SI-1; DS~1 OCT; END %535-08651000
ELSE BEGIN SI~SI-1; DS~2 OCT; END; %535-08652000
TALLY~47; T(TALLY~TALLY+63); %535-08653000
END; %535-08654000
T~TALLY; SI~LOC T; DI~R; DS~WDS; %535-08655000
END;% 08657000
IF OP<47 THEN 08658000
BEGIN;STREAM(A ~ IF RS THEN " RESET" ELSE " SET",% 08659000
O~OPTER INX OP,OP ~ 47-OP,BUS);% 08660000
BEGIN DS ~ LIT " "; SI ~ LOC OP; DS ~ 2 DEC;% 08661000
DS ~ LIT " "; SI ~ O;% 08662000
8(IF SC=0 THEN JUMP OUT TO L; DS~CHR);% 08663000
L: SI ~ LOC A; SI ~ SI+2; DS ~ 6 CHR;% 08664000
DS ~ LIT"~";% 08665000
END;% 08666000
MASK~TWO(OP);% 08667000
M[BUS-1].[9:9]:=0; 08667100
END;% 08668000
SPOUT(BUS INX M[BUS-1]); 08669000
SLEEP([T],IOMASK); 08670000
M[B]~OPTION~IF RS THEN OPTION AND NOT MASK ELSE OPTION OR MASK;08671000
DISKWAIT(B,-30,DIRECTORYTOP-SYSNO); 08673000
FORGETSPACE(OPTER);% 08674000
FORGETSPACE(B);% 08676000
UNLOCKTOG(HOLDMASK); 08677000
END;% 08678000
PROCEDURE TYPOP(KTR,PO); VALUE KTR,PO; REAL KTR,PO; 08679000
BEGIN REAL VASE,TUSTA,N,X,OPTER; 08680000
LABEL INCR; 08680500
REAL SUBROUTINE SETT; 08681000
BEGIN 08681100
STREAM(OPT:=[OPTION]:OPTER,N,NBS:=47-N,VASE); 08681200
BEGIN 08681300
DI:=DI+4; 08682000
SI~OPTER;N(SI~SI+8);IF SC="~" THEN GO TO EXIT;% 08683000
8(IF SC<"0" THEN DS~CHR ELSE DS~1 LIT" ");DS~2 LIT" ";% 08684000
SI:=OPT; SKIP NBS SB; 08684500
IF SB THEN TALLY:=1 ELSE 08685000
BEGIN DS:=3 LIT"NOT"; TALLY:=2; END; 08685500
DS~5 LIT" SET~";% 08686000
DI:=VASE; SI:=LOC NBS; DS:=LIT" "; DS:=2 DEC; DS:=LIT" "; 08686500
EXIT: OPT:=TALLY; 08687000
END; 08688000
SETT~P; 08689000
END SETT; 08689100
% 08689110
SLEEP([TOGLE],HOLDMASK); 08689200
LOCKTOG(HOLDMASK); 08689300
TUSTA:=M[(VASE:=KTR.[15:15]-1)-1]; 08689900
OPTER ~ SPACE(OPTIONSZ)&OPTIONSZ[8:38:10]; 08690000
DISKWAIT(-OPTER,OPTIONSZ,MESSAGETABLE[0].[22:26]); 08690020
IF PO THEN 08690080
BEGIN 08690090
STREAM(BUFF:=KTR, T:=0, OPTER, D:=[N]); 08690100
BEGIN SI~BUFF;63(IF SC=" " THEN SI~SI+1 ELSE JUMP OUT TO L);L: 08690110
IF SC GEQ "0" THEN GO TO L4; 08690120
DI~LOC T; 08690130
8(IF SC=" " THEN JUMP OUT TO L1 ELSE 08690140
IF SC="~" THEN JUMP OUT TO L1 ELSE 08690150
IF SC}"0" THEN JUMP OUT TO L1 ELSE 08690160
DS~1 CHR); L1: 08690170
TALLY~0; BUFF~SI; SI~OPTER; 08690180
63(DI~LOC T;IF 8 SC!DC THEN 08690190
BEGIN IF SC="~" THEN 08690200
BEGIN TALLY~48; JUMP OUT TO L3 END 08690210
ELSE TALLY~TALLY+1; 08690220
END ELSE JUMP OUT TO L2); TALLY~48;GO TO L3;L2: 08690230
IF SC="~" THEN BEGIN SI~BUFF;63(IF SC<"0" THEN SI~SI+1 08690240
ELSE JUMP OUT TO L4); L4: DI~LOC T; SI~SI+1; 08690250
IF SC<"0" THEN BEGIN SI~SI-1; SI~1 OCT END ELSE 08690260
BEGIN SI~SI-1; DS~2 OCT END; 08690270
TALLY~47; T(TALLY~TALLY+63); 08690280
END; 08690290
L3: T~TALLY; SI~LOC T; DI~D; DS~ WDS; 08690300
END; 08690310
IF N LSS OPTER.[8:10] THEN P(SETT,DEL); 08690400
SPOUT(VASE INX TUSTA); 08690600
END ELSE 08690800
BEGIN 08691000
STREAM(KTR:); 08691200
BEGIN SI:=KTR; 08691400
IF SC="S" THEN TALLY:=1 ELSE 08691600
IF SC="R" THEN TALLY:=2 ELSE TALLY:=3; 08691800
KTR:=TALLY; 08692000
END; 08692200
X:=P; N:=-1; 08692400
INCR: N:=N+1; 08692600
IF ((KTR:=SETT) AND X) ! 0 THEN 08692800
BEGIN SPOUT(VASE INX TUSTA); 08693000
VASE:=SPACE(3); 08693200
GO TO INCR; 08693400
END; 08693600
IF KTR=0 THEN 08693800
IF X!3 THEN 08694000
BEGIN STREAM(X:=X=1, VASE); 08694200
BEGIN DS:=12 LIT" ALL OTHERS "; 08694400
X(DS:=4 LIT"NOT "); 08694600
DS:=4 LIT"SET~"; 08694800
END; 08695000
SPOUT(VASE INX TUSTA); 08695200
END ELSE FORGETSPACE(VASE); 08695400
ELSE GO TO INCR; 08695600
END; 08695800
FORGETSPACE(OPTER);% 08696000
UNLOCK(HOLDMASK); 08696100
END;% 08697000
$ SET OMIT = NOT(DISKLOG) 08697099
% THE FOLLOWING THREE DEFINES MUST EACH BE CHANGED IF THE 08699000
% DISK ROW SIZE OF PBD AND PUD FILES IS TO BE CHANGED. 08699050
DEFINE PBDROWSZ = 08699100
300# % %732-08699150
% PBDROWSZ IS THE DISK ROW SIZE, IN SEGMENTS, OF PBD AND 08699200
% PUD FILES. PBDROWSZ MUST BE A MULTIPLE OF THREE. 08699250
,PBDRECS = 08699300
100# % %732-08699350
% PBDRECS=PBDROWSZ/3 : NO. OF LOGICAL RECORDS PER ROW. 08699400
,PBDTOTRECS = 08699450
2000# % %732-08699500
;% PBDTOTRECS=PBDRECS|20 : NO. OF TOTAL RECORDS PER BACK-UP FILE. 08699550
PROCEDURE PBIO(ALPHA,POINTER); VALUE ALPHA; REAL ALPHA,POINTER; %P 08700000
% 08700900
% THIS PROCEDURE HANDLES IO FOR THE CREATION OF BACK-UP FILES. FOR 08700910
% DISK, IT OBTAINS NEW ROWS AND NEW FILES AS NECESSARY. IF IT RUNS 08700920
% OUT OF FILES, HEADER[5].[4:1] IS SET AND THE JOB TERMINATED, LEAVING08700930
% ONE BLOCK FOR THE LABEL AND DS MESSAGE. 08700940
% 08700950
% ALPHA IS ADDRESS OF TOP I/O DESCRIPTOR. <0 MEANS READ %P 08701000
% POINTER IS FIB[14] %P 08702000
BEGIN NAME HEADER; 08703000
REAL T=-2,IOD,H,S; 08704000
INTEGER I=IOD; 08704100
LABEL OK; 08704500
POINTER.[FF]~POINTER INX 72; %P 08705000
IF (HEADER~POINTER.[3:15])!0 THEN %%%%PB ON DISK %%%%% %P 08706000
BEGIN 08707000
HEADER := [M[(*HEADER)]]; 08707500
IF HEADER[7] GEQ PBDTOTRECS-2 THEN % CHECK FOR NEW FILE 08708000
BEGIN 08708200
$ SET OMIT = PACKETS 08708400
IF HEADER[6].[42:6]="9" THEN 08709000
$ POP OMIT OMIT 08709200
IF HEADER[7] GEQ PBDTOTRECS THEN P(XIT) ELSE 08709400
IF HEADER[5].[4:1] THEN GO TO OK ELSE 08709500
BEGIN STREAM(F:=PRT[P1MIX,3] INX M[M[ALPHA-3] INX 4].08709600
[13:11], H:=H:=NABS(SPACE(12))); 08709800
BEGIN SI:=F; SI:=SI+1; 08710000
DS:=24 LIT"TOO MANY BACKUP RECS ON "; 08710200
DS:=7 CHR; DS:=LIT"/"; SI:=SI+1; DS:=7 CHR;08710400
DS:=2 LIT":~"; 08710600
END; 08710800
HEADER[5].[4:1]:=1; 08711000
GO TO OK; 08711200
END; 08711400
IF HEADER[7] GEQ PBDTOTRECS THEN % GET A NEW FILE 08711600
BEGIN 08711800
IF I:=HEADER[5].[3:1] THEN HEADER[5].[3:1]:=0; 08712000
H~SPACE(30); S~M[HEADER INX NOT 0]; 08712100
DISKWAIT(-H,30,S); 08712110
M[H+7]~HEADER[7]; 08712120
M[H+5].[2:1]~0; 08712130
DISKWAIT(H,30,S); 08712140
M[H+7]~M[H+9]~0; 08712150
MOVE(20,H+9,H+10); 08712160
M[H+5]~(*P(DUP)) OR H; 08712170
HEADER[5].[3:1]:=1; %SET CP BK UP TOG 08712200
HEADER[7] := 0; 08712500
HEADER[3] := XCLOCK + P(RTR); 08713000
STREAM(ONE:=1, H:=[HEADER[6]]); 08713250
BEGIN SI:=LOC ONE; DS:=8 ADD; 08713500
DI:=DI+24; 20(DS:=8 LIT"0"); 08713750
END; 08714000
M[H+7]~PBDROWSZ DIV 3; 08714110
HEADER[9]~M[H+9]~1; 08714120
HEADER[10]~M[H+10]~GETUSERDISK(-(PBDROWSZ+1)); 08714130
M[HEADER INX NOT 0] := EUF(-(IF I THEN "PUD " 08714140
ELSE "PBD "),HEADER[6],H-1); 08714150
FORGETSPACE(H); 08714170
$ SET OMIT = PACKETS 08714199
FILEMESSAGE((IF I THEN "PUD " ELSE 08714300
"PBD ")&HEADER[6][24:6:24], 08714310
"OUT " &HEADER[6][30:30:18], 08714320
0," ",0,0,0, 08714330
(PBDREL OR OPNMESS)); 08714340
END; 08714400
END ELSE 08714500
IF HEADER[7] MOD PBDRECS=0 THEN %GET NEW ROW 08715000
BEGIN H:=SPACE(30); S:=M[HEADER INX NOT 0]; 08715100
DISKWAIT(-H,30,S); 08715200
HEADER[9+HEADER[9]~*P(DUP)+1]~ 08716000
GETUSERDISK(-(PBDROWSZ+1)); 08716010
M[H+9+HEADER[9]]~HEADER[9+HEADER[9]]; 08716100
M[H+9]~HEADER[9]; 08716110
M[H+7]~HEADER[7] + PBDROWSZ DIV 3; 08716200
DISKWAIT(H,30,S); 08716300
FORGETSPACE(H); 08716500
END; 08716600
OK: 08716800
STREAM(A~1~HEADER[HEADER[9]+9]+(HEADER[7] MOD 08717000
PBDRECS)|3,D~POINTER.[CF]-1); 08718000
BEGIN SI~LOC A; DS~8 DEC END; %P 08720000
HEADER[7]~(*P(DUP))+1; %P 08721000
IOD~@141330100477777; 08722000
END ELSE %% ON TAPE %% %P 08723000
IOD~@21320500000000&M[POINTER INX NOT 1][3:14:4]; %P 08724000
IOREQUEST(M[ALPHA],POINTER INX IOD&ALPHA[24:1:1], %P 08726000
M[POINTER INX NOT 1]); 08727000
M[T]~IOD INX M[T]$0[26:26:7]&0[19:19:1] AND NOT M; 08728000
IF H LSS 0 THEN 08728500
BEGIN TERMINATE(P1MIX); 08728600
TERMINALMESSAGE(H); 08728700
END; 08728800
END PBIO; 08729000
PROCEDURE TIMERELAXER(KTR,TYPE,MIX);% 08730000
VALUE KTR,TYPE,MIX;% 08731000
REAL KTR,TYPE,MIX;% 08732000
BEGIN INTEGER BUFF,PRT,IOT,T,P1,I1;% 08733000
LABEL SPIT;% 08734000
DEFINE VCT = 29#, % CHANGE TIME LIMITS 08734010
VXT = 30#, % EXTEND TIME LIMITS 08734020
VTL = 31#; % PRINT TIME LIMITS 08734030
COMMENT: THIS ROUTINE SHOULD BE BLAMED ON WWF4;% 08734100
$ SET OMIT = NOT(PACKETS) 08734499
DEFINE UNITNO = PSEUDOMIX[MIX]#;% 08734500
$ POP OMIT 08734501
BUFF ~ KTR.[15:15]-1;% 08735000
IF TYPE NEQ VTL THEN BEGIN; 08736000
STREAM(IOT~0,PRT~0,CODE~0: KTR);% 08737000
BEGIN SI~KTR; IF SC=" " THEN BEGIN L1: SI~SI+1;% 08738000
IF SC=" " THEN GO L1; END; %534-08739000
IF SC="*" THEN BEGIN SI~SI+1; GO L5; END; %534-08739500
IF SC="," THEN GO L2; IF SC<"0" THEN GO EXIT;% 08740000
KTR~SI; L3: TALLY~TALLY+1; SI~SI+1; 08741000
IF SC}"0" THEN GO L3; SI~KTR; CODE~TALLY; 08742000
DI~LOC PRT; DS~CODE OCT; TALLY~0;% 08743000
L5: IF SC=" " THEN BEGIN L4: SI~SI+1;% 08744000
IF SC=" " THEN GO L4 END; IF SC="," THEN GO L2;% 08745000
IF SC="~" THEN TALLY~1; GO EXIT;% 08746000
L2: SI~SI+1; IF SC=" " THEN BEGIN L6: SI~SI+1;% 08747000
IF SC=" " THEN GO L6 END ; KTR~SI;% 08748000
IF SC="*" THEN BEGIN TALLY~1; GO EXIT END;% 08749000
IF SC="~" THEN BEGIN TALLY~1; GO EXIT; END; %534-08749500
IF SC<"0" THEN GO EXIT; L7: TALLY~TALLY+1;% 08750000
SI~SI+1; IF SC}"0" THEN GO L7; DI~ LOC IOT;% 08751000
SI~KTR; CODE~TALLY; DS~CODE OCT; TALLY~1;% 08752000
EXIT: CODE~TALLY;% 08753000
END STREAM;% 08754000
IF NOT P THEN GO SPIT;% 08755000
PRT ~ P|3600; IOT ~ P|3600;% 08756000
IF TYPE=VXT THEN BEGIN 08757000
IF PRT!0 THEN BEGIN% 08758000
PROCTIME[MIX] ~ *P(DUP)-PRT;% 08759000
JAR[MIX,3] ~ *P(DUP)+PRT;% 08760000
END;% 08761000
IF IOT!0 THEN BEGIN% 08762000
IOTIME[MIX] ~ *P(DUP)-IOT;% 08763000
JAR[MIX,4] ~ *P(DUP)+IOT;% 08764000
END END ELSE BEGIN% 08765000
IF PRT!0 THEN BEGIN% 08766000
PROCTIME[MIX] ~ *P(DUP)+JAR[MIX,3]-PRT;% 08767000
JAR[MIX,3] ~ PRT;% 08768000
END;% 08769000
IF IOT!0 THEN BEGIN% 08770000
IOTIME[MIX] ~ *P(DUP)+JAR[MIX,4]-IOT; 08771000
JAR[MIX,4] ~ IOT;% 08772000
END END; 08773000
STREAM(TEST~0: X~JARROW[MIX],MIX,Z~PRT!0,I~IOT!0,% 08774000
K:=TYPE=VXT,T:=T:=SPACE(10)); 08775000
BEGIN DS~LIT " "; Z(DS~4 LIT "PRT "; TALLY~1;% 08776000
I(DS~4 LIT"AND ")); I(DS~4 LIT "IOT "; TALLY~1);% 08777000
DS~8 LIT "ESTIMATE"; Z(I(DS~LIT "S"));% 08778000
DS~8LIT" CHANGED"; K(DI~DI-7; DS~8LIT"EXTENDED"0;% 08779000
DS~5LIT" FOR"; SI~S; SI~SI+1; DS~7CHR; SI~SI+1;% 08780000
DS~LIT"/"; DS~7CHR; DS~LIT"="; SI~LOC Z;% 08781000
SI~SI-8; DS~2DEC; DS~LIT"~"; TEST~TALLY; 08782000
DI~DI-3; DS~FILL; 08782500
END STREAM;% 08783000
IF P THEN SPOUTER(T INX M[BUFF-1],UNITNO,1) ELSE 08784000
FORGETSPACE(T); 08784100
END; 08785000
IOT ~ PRT ~ -0;% 08786000
IF P(JAR[MIX,3],DUP)=@377777777777 THEN P(DEL)ELSE% 08787000
P1 ~ (PRT ~ P DIV 3600)-60|(PRT ~ PRT DIV 60);% 08788000
IF P(JAR[MIX,4],DUP)=@377777777777 THEN P(DEL) ELSE% 08789000
I1 ~ (IOT ~ P DIV 3600)-60|(IOT ~ IOT DIV 60);% 08790000
STREAM(X~JARROW[MIX], MIX,PRT,P1,IOT,I1,BUFF); 08791000
BEGIN DS~17LIT" TIME LIMITS FOR"; SI~X; SI~SI+1; DS~7CHR;% 08792000
DS~LIT"/"; SI~SI+1; DS~7CHR; DS~LIT"="; DI~LOC MIX; 08793000
DS~2DEC; MIX~DI; DI~DI-2; DS~FILL; DI~MIX; 08793500
DS~10LIT" ARE: PRT="; IF SC="+" THEN 08794000
BEGIN SI~SI+16; DS~8LIT"NO LIMIT" END ELSE BEGIN% 08795000
DS~8DEC; DS~LIT":"; DS~2DEC; BUFF~DI; DI~DI-11;% 08795500
DS~7FILL; DI~BUFF END; DS~6LIT"; IOT="; IF SC="+" THEN 08796000
DS~10LIT"NO LIMIT.~" ELSE BEGIN DS~8DEC; DS~LIT":";% 08796500
DS~2DEC; DS~2LIT".~"; DI~DI-13; DS~7FILL END; 08797000
END STREAM;% 08797500
SPIT:% 08798000
SPOUTER(BUFF INX M[BUFF-1],UNITNO,1); 08798500
END TIMERELAXER; 08799000
PROCEDURE CHANGEFACTOR(BUFF,TF); VALUE BUFF,TF; REAL BUFF; BOOLEAN TF; 08800000
BEGIN REAL FACTOR,B,T; INTEGER TEMP=T; 08801000
LABEL TYPEOUT,EXIT; 08802000
BUFF ~ ((B~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 08802500
IF TF THEN GO TYPEOUT; 08803000
STREAM(ANS~0:B); 08804000
BEGIN SI~B; DI~LOC B; DS~8LIT"00000000:; DI~DI-2; 08805000
L: IF SC = " " THEN BEGIN SI~SI+1; GO TO L END; 08806000
IF SC < "0" THEN GO TO L1; 08807000
IF SC > "9" THEN GO TO L1; 08808000
SI~SI+1; 08809000
IF SC < "0" THEN GO TO ONECHR; 08810000
IF SC { "9" 08810500
THEN BEGIN SI~SI-1; DI~DI-2; DS~2 CHR; END 08811000
ELSE ONECHR: BEGIN SI~SI-1; DI~DI-1; DS~1 CHR; END; 08812000
IF SC = "." THEN GO TO L2 ELSE GO TO L3; 08813000
L1: IF SC ! "." THEN GO TO ERROR; 08814000
L2: SI~SI+1; 08815000
IF SC < "0" THEN GO TO ERROR; 08816000
IF SC > "0" THEN GO TO ERROR; 08817000
DS~CHR; 08818000
IF SC } "0" THEN IF SC { "9" THEN DS~CHR; 08819000
L3: IF SC = " " THEN GO CONVERT; 08820000
IF SC = "~" THEN GO CONVERT; 08821000
ERROR:DI~LOC ANS; SKIP 1 DB; DS~ 10 SET; GO TO EXITS; 08822000
CONVERT: SI~LOC B; SI~SI+4; DI~LOC ANS; DS~4 OCT; 08823000
EXITS: 08824000
END STREAM; 08825000
P(.FACTOR,~); 08826000
IF FACTOR < 0 THEN GO TO EXIT; 08828000
CORE.[4:14] ~ FACTOR; 08829000
SLEEP([TOGLE],HOLDMASK); LOCKTOG(HOLDMASK); 08830000
B ~ SPACE(30); 08831000
DISKWAIT(-B,30,DIRECTORYTOP-SYSNO); 08832000
M[B+9] ~ CORE; % CHANGE FACTOR 08833000
DISKWAIT(B,-30,DIRECTORYTOP-SYSNO); 08834000
FORGETSPACE(B); 08835000
UNLOCKTOG(HOLDMASK); 08836000
SELECTION; 08836500
TYPEOUT: 08837000
STREAM(I~(FACTOR~CORE.[4:14]) DIV 100, FR~(TEMP~FACTOR MOD 100), 08838000
MX~(TEMP~CORE.[CF]|64|FCTOR/100),US~CORE.[FF]|64, %749-08839000
$ SET OMIT = NOT WORKSET %749-08839499
NOSELECT~WKSETNOSELECT, %749-08839500
$ POP OMIT %749-08839501
BUFF); %749-08839600
BEGIN DS~9 LIT"FACTOR = "; 08840000
SI~LOC I; DS~2 DEC; I~DI; DI~DI-2; DS~FILL; DI~I; 08841000
DS~LIT"."; DS~2 DEC; 08842000
DS~13 LIT", MAX CORE = "; DS~7 DEC; 08843000
I~DI; DI~DI-7; DS~6 FILL; DI~I; 08844000
DS~7LIT",USING "; DS~7 DEC; I~DI; DI~DI-7; DS~6 FILL;%749-08845000
DI:=I; %749-08845500
$ SET OMIT = NOT WORKSET %749-08845999
NOSELECT(DS:=14 LIT ",WKSETNOSELECT"); %749-08846000
$ POP OMIT %749-08846001
DS:=LIT"~"; %749-08846010
END STREAM; 08847000
EXIT: SPOUT(BUFF); 08848000
END CHANGEFACTOR; 08849000
PROCEDURE SHEETDIDDLER(BUFF,TYPE,STD); VALUE BUFF,TYPE,SID; 08850000
REAL BUFF,TYPE,SID; 08850100
COMMENT TYPE = 6: PS -- CHANGE PRIORITY OF JOB IN SCHEDULE 08850200
= 8: XS -- EXECUTE JOB IN SCHEDULE (FORCE SELECTION) 08850300
= 7: ES -- ELIMINATE JOB FROM SCHEDULE (FORCE SELECTION, 08850400
THEN "DS") 08850500
= 5: TS -- TYPE OUT SCHEDULE; 08850600
BEGIN REAL IOD,T,PRIORITY; 08851000
INTEGER LEVEL,NEXTLINK,THISLINK,LASTLINK; 08852000
INTEGER ES,EM,EH; DEFINE ET = EH#; 08852500
$ SET OMIT = NOT(DATACOM ) 08852599
BOOLEAN LASTPASED,ATLEASTONE; 08853000
ARRAY S[*],DLNK[*]; 08854000
$ SET OMIT = NOT(PACKETS) 08854499
DEFINE UNITNO = S[23].[2:6]#; % ORIGINATING UNIT 08854500
$ POP OMIT 08854501
LABEL CONTINUE,C1,READIN,GNX,TS,TS1,TS2, 08855000
XSES,ESLL,PS,PS1,PS2,SPIT,EXIT; 08856000
SUBROUTINE GETNEXT; % READS IN NEXT JOB SHEET ENTRY 08858000
BEGIN 08859000
CONTINUE: LASTLINK ~ THISLINK; 08860000
IF (THISLINK~NEXTLINK) ! 0 THEN GO TO READIN; 08860500
C1: IF (LEVEL~LEVEL+1) > MIXMAX THEN 08861000
BEGIN LASTPASSED ~ TRUE; GO TO GNX END; 08862000
LASTLINK ~ NEXTLINK ~ 0; 08863000
IF (THISLINK~SHEET[LEVEL].[CF]) = 0 THEN GO TO C1; 08864000
READIN: DISKIO(IOD,-(S INX 0-1),30,THISLINK); 08865000
SLEEP([IOD],IOMASK); 08866000
NEXTLINK ~ S[29]; 08867000
IF S[0].[36:6]=@14 THEN GO CONTINUE;%PASS LM ENTRY 08868000
GNX: 08869000
END GETNEXT; 08870000
SLEEP([TOGLE],SHEETMASK); LOCKTOG(SHEETMASK); 08880000
S := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-08881000
LEVEL ~ -1; LASTPASSED ~ FALSE; 08882000
IF BUFF!0 THEN 08882050
BUFF ~ ((T~BUFF).[15:15]-1)&M[P(DUP)-1][9:9:9]; 08882500
$ SET OMIT = NOT(DATACOM ) 08882599
IF TYPE=5 THEN GO TS; IF TYPE GTR 6 THEN GO XSES; GO PS; 08883000
IS: ATLEASTONE ~ FALSE; 08884000
IS1: GETNEXT; IF LASTPASSED THEN GO TO TS2; 08885000
IF SID NEQ 63 THEN BEGIN IF S[3].[8:10]NEQ SID THEN GO TS; END ELSE 08885500
IF ATLEASTONE THEN BUFF.[CF]~SPACE(12); 08886000
ET~((CLOCK+P(RTR))/60)-S[23].[24:24]; 08886300
ES ~ ET MOD 60; ET ~ ET DIV 60; EM ~ ET MOD 60; EH ~ ET DIV 60; 08886600
STREAM(TU~S[23].[9:4],BUF~S[23].[14:4], 08887000
RT:=S[23].[9:4] NEQ 0,C:=LEVEL,J1:=(S[0] LSS 0) OR 08887001
(S[2].SSYSJOBF = LIBMAINCODE),J2:=S[27], 08887010
J~S[*],ID~S[3].[8:10],EH,EM,ES,A~S[20]|64,BUFF); % 08887100
BEGIN SI~LOC C; DS~6 DEC; DI~DI-6; DS~5 FILL; DI~BUFF; DI~DI+6; 08888000
DS~LIT":"; SI~J; SI~SI+1; DS~7 CHR; DS~LIT"/"; SI~SI+1; 08889000
DS:=7CHR;J1(DS:=LIT" ";SI:=LOC J2;SI:=SI+1;DS:=7CHR); 08890000
DS:=LIT"=";SI:=LOC ID;DS:=2 DEC; 08890010
RT(DS~6 LIT " FROM "; SI~LOC TU; DS~2 DEC; % 08890100
DS~1 LIT "/"; SI~LOC BUF; DS~2 DEC;); % 08890200
DS~7 LIT" IN FOR"; SI~LOC EM; 08891000
3(DS ~ LIT":"; DS~2 DEC); ES~DI; DI~DI-9; DS~8 FILL; 08892000
DI~ES; DS~8 LIT", NEEDS "; 08893000
SI~LOC A; DS~5 DEC; DS~LIT"~"; DI~DI-6; DS~4 FILL; 08899000
END STREAM; 08900000
SPOUTER(BUFF,IF SID!63 THEN UNITNO ELSE 0,1); 08901000
IF SID NEQ 63 THEN BEGIN TYPE:=5;GO EXIT END; 08901500
ATLEASTONE~TRUE; 08902000
GO TO TS; 08903000
TS2: IF ATLEASTONE THEN GO TO EXIT; 08904000
IF SID NEQ 63 THEN YTPE:=5 ELSE% 08904050
STREAM(BUFF); DS ~ 15 LIT " NULL SCHEDULE~";% %WF 08905000
SPOUT(BUFF); GO TO EXIT; 08906000
XSES: GETNEXT; 08910000
IF LASTPASSED THEN BEGIN IF BUFF!0 THEN SPOUT(BUFF); 08911000
GO TO EXIT; END; 08911050
IF S[3].[8:10]~SID THEN GO TO XSES; 08912000
$ SET OMIT = NOT(DATACOM ) 08912099
S[2].[1:2]:=(IF TYPE=8 THEN 2 ELSE 3); % 7=ES,8=XS 08913000
DISKIO(IOD,S INX 0-1,30,THISLINK); SLEEP([IOD],IOMASK); 08915000
GO TO SPIT; 08915100
PS: STREAM(PRIORITY:T); 08916000
BEGIN SI~T; 08917000
N: IF SC="~" THEN GO TO X; 08918000
IF SC<"0" THEN BEGIN SI~SI+1; GO TO N; END; T~SI; 08919000
K: IF SC}"0" THEN IF SC{"9" THEN 08920000
BEGIN TALLY~TALLY+1; SI~SI+1; GO TO K END; 08921000
SI~T; DI~LOC PRIORITY; T~TALLY; DS~T OCT; GO TO Z; 08922000
X: DI~LOC PRIORITY; SKIP DB; DS~11 SET; 08923000
Z: 08924000
END STREAM; 08925000
IF (PRIORITY~P)<0 THEN BEGIN SPOUT(BUFF); GO TO EXIT END; 08926000
PS1: GETNEXT; IF LASTPASSED THEN BEGIN SPOUT(BUFF); GO TO EXIT END; 08927000
IF S[3].[8:10]!SID THEN GO TO PS1; 08928000
% DELINK AND RELINK THIS SHEET ENTRY 08929000
DLNK := [M[TYPEDSPACE(31,SHEETAREAV)]] & 30[SIZE];% %167-08930000
IF NEXTLINK = 0 THEN SHEET[LEVEL].[FF] ~ LASTLINK; 08931000
IF LASTLINK = 0 THEN BEGIN SHEET[LEVEL].[CF]~ NEXTLINK;GO PS2 END;08932000
DISKIO(IOD,-(DLNK INX 0-1),30,LASTLINK); SLEEP([IOD],IOMASK); 08933000
DLNK[29] ~ NEXTLINK; 08934000
DISKIO(IOD,+(DLNK INX 0-1),30,LASTLINK); SLEEP([IOD],IOMASK); 08935000
PS2: S[2].[CF] ~ IF (S[18]~PRIORITY) > 32767 THEN 32767 ELSE PRIORITY; 08936000
LEVEL ~ IF PRIORITY > MIXMAX THEN MIXMAX ELSE PRIORITY; 08937000
IF SHEET[LEVEL].[CF] ~ 0 THEN 08938000
BEGIN DISKIO(IOD,-(DLNK INX 0-1),30,SHEET[LEVEL].[FF]); 08939000
SLEEP([IOD],IOMASK); 08940000
DLNK[29] ~ THISLINK; 08941000
DISKIO(IOD,+(DLNK INX 0-1),30,SHEET[LEVEL].[FF]); 08942000
SLEEP([IOD],IOMASK); 08943000
END ELSE SHEET[LEVEL] ~ THISLINK; 08944000
SHEET[LEVEL].[FF] ~ THISLINK; 08944500
S[29] ~ 0; S[3] ~ ABS(S[3]); % TO GET SELECTION TO PRINT MESSAGE; 08945000
DISKIO(IOD,+(S INX 0-1),30,THISLINK); SLEEP([IOD],IOMASK); 08946000
FORGETSPACE(DLNK); 08947000
SPIT: IF BUFF!0 THEN 08947100
$ SET OMIT = NOT(PACKETS) 08947199
IF UNITNO GEQ 32 THEN 08947200
BEGIN 08947300
MOVE(9,BUFF+1,BUFF); SPOUTER(BUFF,UNITNO,64); 08947400
END ELSE 08947500
$ POP OMIT 08947501
FORGETSPACE(BUFF); 08947600
EXIT: UNLOCKTOG(SHEETMASK); 08997000
FORGETSPACE(S); 08998000
IF TYPE!5 THEN BEGIN KEYBOARDCOUNTER ~ KEYBOARDCOUNTER-1; 08998200
SELECTION; 08998400
KEYBOARDCOUNTER ~ KEYBOARDCOUNTER+1; 08998600
END; 08998800
END SHEETDIDDLER; 08999000
$ SET OMIT = NOT(DCSPO AND DATACOM ) 08999999
$ SET OMIT = NOT(DISKLOG) 09299999
PROCEDURE WHATINTRNSIC(BUFF); VALUE BUFF; REAL BUFF; FORWARD; 09400000
$ SET OMIT = NOT(AUXMEM) 09400099
$ SET OMIT = NOT MONITOR 09410100
$ SET OMIT = NOT AUXMEM 09433590
PROCEDURE INTRINSICTABLEBUILDER(FH); VALUE FH; REAL FH; 09500000
BEGIN 09500500
% WHEN CALLED WITH FH= (-1), TRANSFER TO AUXMEM ONLY 09500510
REAL DISKADDR=+1,T=+2,INTLOC=+3,T17SIZE=+4,MAXINT=+5; 09501000
$ SET OMIT = NOT(AUXMEM) 09501500
P(0, 0, 0, 0, 0); 09504570
IF (T:=FH.[FF])=0 THEN T:=SPACE(30); 09505000
$ SET OMIT = NOT(AUXMEM) 09505100
DISKWAIT(-T, 30, DISKADDR:=M[FH INX 10]); 09505500
MAXINT := M[T] ~ 1; % NUMBER OF INTRINSICS + 1 09505600
T17SIZE := M[T INX 17].[8:10]+1; % INTR.#17 SIZE+1WD.FOR DISK.ADDR. 09505700
FORGETSPACE(T); 09505750
INTRNSC:=[M[INTLOC:=GETSPACE(MAXINT+I17SIZE,INTARRAYAREAV,1)+2]]& 09506000
(MAXINT+T17SIZE)[8:38:10]; % SPACE FOR INTRINSIC TABLE + INT.#17 09506100
DISKWAIT(-(INTRNSC INX 0),MAXINT,DISKADDR); 09506500
M[INTRNSC INX NOT 0] := 0; MAXINT := MAXINT -1; 09507000
FOR T := 1 STEP 1 UNTIL MAXINT DO 09507500
INTRNSC[T]:=NABS(([(*P(DUP),DUP).[8:10]+INTSIZE) & 09508000
(P(XCH) INX 0 + DISKADDR)[6:21:27]); 09508500
DISKWAIT(-(INTLOC:=INTLOC+MAXINT+2),(T17SIZE-1),INTRNSC[17].[6:27]); 09508600
INTRNSC[17] := (*P(DUP))&INTLOC[CTC]; % MARK PERCENT 09508700
M[INTLOC-1]:=0&(T17SIZE-1)[CTF]; % DUMMY MARKER FOR DUMP/ANALYZE 09508800
DISKADDR:=0&1[4:47:1]; 09509000
INTRNSC[2]:=*P(DUP) OR DISKADDR; 09509500
FOR T:=18 STEP 1 UNTIL 20 DO INTRNSC[T]:=*P(DUP) OR DISKADDR; 09510000
$ SET OMIT = NOT(AUXMEM) 09510500
INTSIZE:=(INTRNSC[0] + 3 ) DIV 4; 09534500
$ SET OMIT = NOT(PACKETS) 09534999
T:=SPACE(15); WHATINTRNSIC(T); 09535000
STREAM(S:=T,D:=3); 09535100
BEGIN 09535200
SI:=S; DI:=DI+4; % CMBIT IN M[3].[1:1] 09535300
63(IF SC="." THEN JUMP OUT; SI:=SI+1); S:=SI; 09535400
4(SI:=SI+1; IF SC="." THEN JUMP OUT); 09535500
IF TOGGLE THEN ELSE SI:=S; SI:=SI+1; 09535600
3(IF SC<"0" THEN JUMP OUT; TALLY:=TALLY+1; SI:=SI+1); 09535700
S:=TALLY; SI:=SI-S; DI:=DI-S; DS:=S CHR; 09535800
END; 09535900
FORGETSPACE(T); 09536000
$ POP OMIT 09536001
END INTRINSCI TABLE BUILDER; 09537000
PROCEDURE CHANGEINTRINSICFILE(BUFF); VALUE BUFF; REAL BUFF;% 09600000
BEGIN REAL A,B,IOD,I,J,K,L; 09601000
REAL FH,T,IT; LABEL FXIT,WITHOUT; 09602000
REAL SIZE=I,DISKADDR=T,LOC=IT,WI=J; 09602100
BOOLEAN SUBROUTINE NULLMIX;% 09603000
BEGIN POLISH(1);% 09604000
IF INTSIZE!0 THEN BEGIN INTSIZE ~ 0;% 09605000
FOR I~1 STEP 1 UNTIL MIXMAX DO% 09606000
IF JARROW[I]!0 THEN% 09607000
IF NOT (JAR[I,9].SYSJOBF) THEN % NOT "SYSTEM" JOB 09608000
BEGIN P(DEL, 0); I ~ MIXMAX; END;% 09611000
IF NOT P(DUP) THEN INTSIZE ~ (INTRNSC[0]+3) DIV 4;% 09612000
END;% 09613000
NULLMIX ~ POLISH;% 09614000
END NULLMIX;% 09615000
SUBROUTINE FORGETEM;% 09616000
BEGIN SLEEP([TOGLE],STOREMASK); LOCKTOG(STOREMASK); 09617000
WHILE (K ~ M[L]).[CF]!0 DO% 09618000
BEGIN IF K>0 THEN% 09619000
IF K.[3:12]=@700 THEN% 09620000
FORGETSPACE(L+2);% 09621000
L ~ K.[CF];% 09622000
END;% 09623000
UNLOCKTOG(STOREMASK); 09624000
$ SET OMIT = NOT(AUXMEM) 09624010
FORGETSPACE(INTRNSC INX 0); INTRNSC~0 09624100
END FORGETEM;% 09625000
DEFINE ERROR = GO TO EXIT#;% 09626000
SLEEP([TOGLE], FREEMASK); INTFREE ~ FALSE;% 09630000
T ~ BUFF;% 09631000
NAMEID(A,T); NAMEID(B,T); NAMEID(B,T);% 09632000
IF (FH:=DIRECTORYSEARCH(A,B,17))=0 THEN ERROR; 09633000
IF (J~M[FH+4].[36:6])!0 THEN 09633100
IF J!DCINTYPE AND J!TSSINTYPE THEN 09633200
BEGIN % DONT ALLOW CI ON KNOWN NON-INTRINSICS FILE 09633300
STREAM(A,B,NT1:=BUFF.[15:15]-1); 09633400
BEGIN DS:=2LIT"# "; SI:=LOC A; 09633500
SI:=SI+1; DS:=7CHR; DS:=LIT"/"; 09633600
SI:=SI+1; DS:=7 CHR; 09633700
DS:=24 LIT" NOT AN INTRINSICS FILE~"; 09633800
END; 09633900
FORGETSPACE(FH); 09634000
FORGETSPACE(DIRECTORYSEARCH(A,B,16)); 09634100
ERROR; 09634200
END; 09634300
IF NOT NULLMIX THEN COMPLEXSLEEP(NULLMIX); 09635000
IF INTRNSC!0 THEN FORGETEM; 09636000
$ SET OMIT = SHAREDISK 09636999
IF MCPFREE=0 THEN SLEEP([TOGLE],MCPMASK); 09637000
LOCKTOG(MCPMASK); 09638000
$ POP OMIT 09638001
T:=SPACE(30); 09639000
OKSEGZEROWRITE:=TRUE; %204-09639001
DISKWAIT(-T,-30,0); 09640000
I:=T+13+5|SYSNO; 09641000
IF (IT:=DIRECTORYSEARCH(M[I],M[I+1],16))!0 THEN 09642000
FORGETSPACE(T); 09643000
M[I]:=A; 09644000
M[I+1]:=B; 09645000
DISKWAIT(T,-30,0); 09646000
OKSEGZEROWRITE:=FALSE; %204-09646001
$ SET OMIT = SHAREDISK 09646999
UNLOCKTOG(MCPMASK); 09647000
$ POP OMIT 09647001
$ SET OMIT = NOT(AUXMEM) 09647999
FORGETSPACE(T); 09648000
INTRINSICTABLEBUILDER(FH.[CF]); 09657000
FORGETSPACE(FH); 09658000
WHATINTRNSIC(BUFF.[15:15]); 09659000
STREAM(B:=BUFF.[15:15]-1); DS:=8 LIT" NEW "; 09670000
EXIT: SPOUT(BUFF.[15:15]-1);% 09676000
INTFREE ~ TRUE;% 09677000
END CHANGING INTRINSIC FILES ON USER DISK WITH MANY PRECAUTIONS;% 09679000
PROCEDURE CHANGEMCP(BUFF); VALUE BUFF; REAL BUFF; 09679100
BEGIN 09679200
REAL A,B,T,Z,BASE; 09679300
LABEL EXIT; 09679400
T:=BUFF; 09679800
NAMEID(A,T); NAMEID(B,T); NAMEID(B,T); 09679900
$ SET OMIT = SHAREDISK 09679999
IF MCPFREE=0 THEN SLEEP([TOGLE],MCPMASK); 09680000
LOCKTOG(MCPMASK); 09680100
$ POP OMIT 09680101
Z:=SPACE(30); 09680200
OKSEGZEROWRITE:=TRUE; %204-09680229
DISKWAIT(-Z,-30); 09680300
BASE:=Z+10+5|SYSNO; 09680400
IF (A EQV M[BASE])!NOT 0 OR 09680500
(B EQV M[BASE+1])!NOT 0 THEN 09680600
BEGIN 09680700
IF (T:=DIRECTORYSEARCH(A,B,17))=0 THEN 09680800
BEGIN; 09680900
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09681000
BEGIN DS:=13 LIT"#NO MCP FILE ";SI:=A;SI:=SI+1; 09681100
DS:=7 CHR;DS:=LIT"/";SI:=SI+1;DS:=7 CHR; 09681200
DS~LIT"~"; 09681250
END; 09681300
GO TO EXIT; 09681400
END; 09681500
IF (NT1~M[T+4].[36:6])!0 THEN IF NT1!MCPTYPE THEN 09681505
BEGIN % DONT ALLOW CM ON KNOWN NON-MCP FILE 09681510
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09681515
BEGIN DS:=2LIT"# "; SI:=A; SI:=SI+1; 09681520
DS:=7CHR; DS:=LIT"/"; SI:=SI+1; 09681525
DS:=7CHR; DS:=12LIT" NOT AN MCP~"; 09681530
END; 09681535
FORGETSPACE(T); 09681540
FORGETSPACE(DIRECTORYSEARCH(A,B,16)); 09681545
GO TO EXIT; 09681550
END; 09681555
IF M[BASE+2]-2!MCPBASE THEN 09681600
FORGETSPACE(DIRECTORYSEARCH(M[BASE],M[BASE+1],16)); 09681650
M[BASE]:=A; 09681700
M[BASE+1]:=B; 09681800
M[BASE+2]:=M[T+10]; 09681900
$ SET OMIT = NOT(AUXMEM) 09681909
FORGETSPACE(T); 09682000
END; 09682100
STREAM(A:=[A],T:=BUFF.[15:15]-1); 09682200
BEGIN DS:=18 LIT " NEXT MCP WILL BE ";SI:=A;SI:=SI+1; 09682300
DS:=7 CHR;DS:=LIT"/";SI:=SI+1;DS:=7 CHR; 09682400
DS~LIT"~"; 09682450
END; 09682500
M[3]~NABS(*P(DUP)); % SET FLAG FOR WM 09682550
EXIT: 09682600
DISKWAIT(Z,-30,0); 09682610
OKSEGZEROWRITE:=FALSE; %204-09682611
$ SET OMIT = NOT(NOT SHAREDISK) 09682619
UNLOCKTOG(MCPMASK); 09682620
$ POP OMIT 09682621
FORGETSPACE(Z); 09682700
SPOUT(BUFF.[15:15]-1); 09682800
END CHANGING OF THE MCP; 09683100
Reference in New Issue View Git Blame Copy Permalink