COMPRO867
(George Source)
Macros used: ACROSS, ADDREC, BS, CCOFF, CHAIN, CJOBLOCK, CLEANX, COMERR, COMREADY, DOWN, FJOCA, FPCACA, FPCAJO, FREECORE, FREEPER, GEOERR, GETWORD, HLSINFORM, HUNTW, ISSUERR, ISSUFIN, ISSUFINB, JBS, MHUNT, MHUNTW, MHUNTX, MONOUT, NAME, OUTNULL, OUTPAR, OUTPARAM, PHOTO, RDLCHECK, READ, READY, RINGTP, RVHOOK, SEG, SEGENTRY, SWAP, T, TESTHKN, TESTINBRK, TESTMOVE, TESTRCTP, TESTTP, TRACE, UNSETHK, VFREEW, WORDFIN
- COMPRO867.txt
227M ... SEG COMPRO,,CENT(COMMAND PROCESSOR),,G286,G400 22*# ...[ 22G^ ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 22NL ...[ THIS EXCLUDES CODE UNDER #SKI G286 22W? ...[ 233Y ...#OPT G286 = 0 239K ...#SKI G286&1 23C= ...# WITH UGUG EDIT M286 (MULTI-COMMAND LINES) 23JX ...# PLUS GENERALISED CODE CLEARING CPAT BITS IN CPATUWORD 23QJ ...# USED BY VARIOUS MENDS FOR THE DURATION OF A COMMAND 23YG [ THE ENTRY POINTS 24D6 [ THESE ENTRY POINTS MUST BE KEPT FIXED WITHIN THE SEGMENT 24K# ...#UNS G400 24QG ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK 2 24XQ ... SEGENTRY K1COMPRO,(GEOERR) 25CB SEGENTRY K2COMPRO,QENTRY2 25X2 ... SEGENTRY K3COMPRO,(GEOERR) 26BL SEGENTRY K4COMPRO,QENTRY4 26W= SEGENTRY K5COMPRO,QENTRY5 27*W ... SEGENTRY K7COMPRO,(GEOERR) 27TG ... SEGENTRY K9COMPRO,(GEOERR) 28*6 SEGENTRY K10COMPRO,QENTRY10 28SQ SEGENTRY K11COMPRO,QENTRY11 29#B SEGENTRY K12COMPRO,QENTRY12 29S2 SEGENTRY K13COMPRO,QENTRY13 2=?L SEGENTRY K14COMPRO,QENTRY14 2=R= SEGENTRY K15COMPRO,QENTRY15 2?=W SEGENTRY K16COMPRO,QENTRY16 2?QG [ 2#=6 [ 2#PQ [ THIS IS THE CENTRAL SEGMENT OF THE COMMAND PROCESSOR. 2*9B ...[ THE SEGMENT CAN BE DIVIDED INTO FOUR SECTIONS. 2*P2 ...[ 1 LOCATION. FINDS THE NEXT COMMAND THEN ENTERS ALAS. 2C7W [ IF BREAK-IN DETECTED THEN ENTERS COMPROB. 2CMG ...[ 2 RE-ENTRY. VARIOUS ENTRY POINTS FROM COMMANDS. 2D76 ...[ 3 ERROR. ONLY ENTERED AFTER A COMMAND ERROR. 2DLQ ...[ 4 CLEAN-UP. ENTERED ON SUCCESSFUL COMPLETION OF COMMAND. 2F6B ...[ 2L^W MINUS1 -1 2MFG TIM +JABANDTIME 2M^6 [ FOLLOWING IDENTIFIER LABELS THE MESSAGE 'JOB ABANDONED : MAXIMUM 2NDQ [ COMMAND PROCESSOR LEVEL EXCEEDED' 2NYB MAX +JABANDMAX 2PD2 MASKPI #10000 [ISOLATES THE PROGRAM ISSUED BIT 2PXL MASKJR #47777777 2QWW MASKSSI #37777700 2STB TEN +10 2T*2 THOUSAND +1000 2W#= [ 2WRW [ SUBROUTINES * * * * 2X?G [ 2XD8 TELLHLS 2XFQ SBX 7 FX1 2XH# HLSINFORM XTELLB,HALT,JOBNO(2) 2XJW XTELLB 2XLD ADX 7 FX1 2XN2 EXIT 7 0 2XR6 RTP SBX 7 FX1 [FORM REL LINK 2Y=Q FJOCA 3,2 [GET PTR TO JOBBLOCK 2YQB TESTRCTP 3,NOTR [J IF NOT RCTP 2^=2 TEND 2^PL FPCACA 3,2 [GET PTR TO PCA 329= ADX 7 FX1 32NW EXIT 7 0 338G NOTR FPCAJO 3 33N6 TESTTP 3,TEND [J IF TP 347Q RINGTP 3 34MB BRN TEND 3572 [ S/R TO FIND A WHENEVER LEVEL OR AN INT-ISSUED LEVEL 35LL [ ON ENTERING S/R X4 IS 0,1 OR -VE 366= [ IF X4=0 ,ON FINDING MACRO LEVEL WITH NO WHENEVER SET BRK-IN CHAR IN 36KW [ EXT+10 IS SET TO 3 I.E. BRK-IN BEFORE. THIS IS FOR CASE OF 375G [ BRK-ING IN ON PROG.ISSUED MACRO. - W/BRK CASE 37K6 [ IF X4=1 ,THIS MEANS ABOVE SEARCH IS OMITTED , AND ALSO ONLY SPEC. 384Q [ INT.ISSUED LEVELS CAUSE EXIT I.E. THOSE WITH BRK-IN LABEL- 38JB [ THIS IS BECAUSE FINISH CAUSES BRK-IN AND SO MUST RETURN TO 3942 [ THE BRK-IN LABEL BEFORE TAKING W/FINISH ACTION AT A HIGHER 39HL [ LEVEL - W/FINISH CASE 3=3= [ IF X4 IS -VE THIS IS COMERR CASE SO EXIT AT WHENEVER OR ANY INT ISS 3=GW [ LEVEL. 3?2G SEEKLEV 3?G6 LDX 2 FPTR(2) 3?^Q LDX 0 ATYPE(2) 3#FB SRL 0 12 [ FIND NEXT CPB/CALAS 3#^2 ERN 0 CPB+CALAS [ BLOCK 3*DL BNZ 0 SEEKLEV 3*Y= LDEX 6 CPBCPLEV(2) [ISOLATE CP LEVEL 3BCW LDCT 5 #600 3BXG ANDX 5 CPBCPLEV(2) [ISOLATE INT ISS BITS 3CC6 BZE 6 SEEK1 [J IF ZERO LEVEL REACHED 3CWQ BPZ 5 SEEK2 [J IF NOT INT ISSUED 3DBB BNG 4 SEEK3 [J IF WANT TO EXIT FOR ANY I.I. LEV. 3DW2 SLL 5 1 3F*L BPZ 5 SEEKLEV [J IF II.LEVEL HAS NO BRK-IN LABEL 3FT= SEEK3 EXIT 7 1 [I.ISS. EXIT 3G#W SEEK2 3GSG LDX 0 CPBFSD(2) 3H#6 BPZ 0 SEEK4 [J IF MACRO LEVEL 3HRQ SEEK1 EXIT 7 0 [NO WHEN/INT ISS LEVEL 3J?B SEEK4 3JR2 CALL 5 WHENEVER [SEARCH FOR WHENEVER 3K=L EXIT 7 2 [WHENEVER FOUND 3KQ= BNZ 4 SEEKLEV [J IF NOT W/BRK CASE 3L9W SMO FX2 3LPG LDX 0 CONTEXT 3M96 SMO FX1 3MNQ ANDX 0 MASKPI 3N8B BZE 0 SEEKLEV 3NN2 LDN 0 3 3P7L LDX 3 FX2 [ RESET TO BROKEN 3PM= DCH 0 EXT+10(3) [ IN BEFORE 3Q6W BRN SEEKLEV [PROG. ISSUED MACRO 3QLG # 3R66 [ S/R TO SEARCH FOR A WHENEVER BLOCK OF THE SAME TYPE AS HELD IN 3RKQ [ AWORK1 3S5B [ ON ENTRY TO S/R X2 POINTS TO A CPB/CALAS AT A MACRO LEVEL 3SK2 # 3T4L WHENEVER 3TJ= LDX 3 FPTR(2) 3W3W LDN 1 JWHEN [POSS NO. OF WHENEVER BLOCKS 3WHG WHEN1 3X36 LDX 3 FPTR(3) 3XGQ LDX 0 ATYPE(3) 3Y2B SRL 0 12 3YG2 SMO FX2 3Y^L TXU 0 AWORK1 3^F= BCS WHEN2 [J IF NOT REQ. TYPE 3^YW EXIT 5 0 [WHENEVER FOUND 42DG WHEN2 42Y6 ERN 0 CPB+CALAS 43CQ BZE 0 WHEN3 [J IF NEXT /CALAS REACHED 43XB BCT 1 WHEN1 [-SO SEARCH MUST STOP 44C2 WHEN3 44WL EXIT 5 1 [NO WHENEVER FOUND 45B= # 45TW [ S/R TO FIND WHENEVER BLOCK (TYPE IN AWORK1) AND RENAME IT 46*G [ AN ADATA/CREADL BLOCK. X2 MUST = FX2 46T6 # 47#Q SETCREADL 47SB LDX 0 AWORK1(2) 48#2 SLL 0 12 48RL MHUNTX 3,0 49?= NAME 3,ADATA,CREADL 49QW CHAIN 3,FX2 4==G EXIT 7 0 4=Q6 # 4?9Q [ S/R FOR CLEANING UP TO CPLEVEL GIVEN IN X6 AND RESETTING CPLEV 4?PB [ IN MOST S/R MUST ALSO CHECK FOR I.I LEVELS CLEARED OUT & OBEY A 4#92 [ FREELINK FOR EACH ONE 4#NL # 4B7G TCLEAN 4BM6 SBX 4 FX1 4C6Q CLEANX 6,1 [CLEANUP CPAT CHAIN 4CLB STO 6 CPLEV(2) 4D62 ...#UNS CPATUMASK 4DKL ...( 4F5= ... LDN 0 CPATUMASK 4FJW ... ANDS 0 CPATUWORD(2) 4G4G ...) 4JGL ADX 4 FX1 4K2= EXIT 4 0 4KFW # 4K^G [ S/R FOR REDUCING CPLEV AND RESETTING AMFMSK FOR THE HIGHER LEVEL 4LF6 [ IN MOST CASES S/R ALSO FREES CPB/CALAS AND CLB PAIR - ON ENTRY 4LYQ [ X2 POINTS TO /CALAS AND X3 TO CLB 4MDB # 4MY2 UPLEV FREECORE 2 [FREE /CALAS 4NCL FREECORE 3 [FREE CLB 4NX= UPLEV1 4PBW LDN 6 1 4PWG SBS 6 CPLEV(2) [REDUCE CPLEV BY 1 4QB6 MHUNTW 3,CPB,CALAS 4QJR SEGENTRY K70COMPRO 4QM2 BRN XK71 [MENDED TO NULL IF REPORTNEST ON 4QP9 LDN 6 #10 4QRD ANDX 6 CONTEXT(2) 4QTM BZE 6 XK71 4QXW LDX 6 CMXMSK(3) [RESET REPORTING MAK TO THAT AT 4R25 STO 6 AMXMSK(2) [NEW LEVEL FOR MOP CONTEXT ONLY 4R4# XK71 4R6H SEGENTRY K71COMPRO 4R82 ...#UNS G400 4R9F ... RVHOOK 3 4R=^ LDX 6 CMFMSK(3) [ RESET AMFMSK TO CMFMSK AT CURRENT 4R*B STO 6 AMFMSK(2) [ NEW LEVEL 4RT2 EXIT 5 0 4S#L [ 4SS= [ MAIN ROUTINE * * * * 4T?W [ 64*W PBM FREECORE 3 64TG QENTRY12 [ ENDREC 65*6 NGN 0 2 65SQ ANDS 0 EXT+9(2) [UNSET B23 - ANALYSIS FINISHED 66#B LDN 0 2 66S2 DCH 0 EXT+10(2) 67?L BRN READLQ 67R= [ 68=W [ 68QG QENTRY5 [ PROGBRKIN 69=6 MHUNTW 1,CPB,CALAS [ CLEAR THE 'VERB WITHIN DELIMITERS 69PQ NGN 4 3 [ HAS ALREADY BEEN SET' BIT IN 6=9B ANDS 4 CPBPROGLEV(1) [ CALAS BLOCK IF IT IS SET 6=P2 CALL 7 RTP 6?8L LDX 0 AMON(3) [LOAD AMON OF PCA 6?N= BPZ 0 NOTM [J IF NOT MONRESUM IN PROGRESS 6#7W LDX 0 BITS22LS 6#MG ANDS 0 AMON(3) [ERASE MONRESUM BITS 6*76 LDN 4 8 [NOW SET O/P ONR TO WORD AFTER MNTRD 6*LQ LDN 5 2 [ EXTRACODE-V. INEFFICIENT,BUT RARE! 6B6B GETWORD 4,3,WRITE,6,5 6BL2 LDCT 0 #100 6C5L ANDX 0 1(3) 6CK= SLC 0 3 [X0=1 IF XCOD IS SMO-ED ELSE 0 6D4W ADN 0 1 6DJG ADS 0 0(3) [STEP FORWARD O/P ONR AGAIN 6F46 WORDFIN 6F9# #SKI JWPHASE4 6FBG CALL 7 TELLHLS 6FHQ [ 6G3B QENTRY13 [ COMBRKIN - BREAKIN AND ABANDON 6GH2 TBEF 6H2L STOZ EXT+8(2) 6HG= LDN 0 3 6H^W BRN SCRAP 6JFG [ 6J^6 [ 6KDQ QENTRY14 [ ABANDCOM 6KYB LDN 0 4 6LD2 SCRAP 6LXL DCH 0 EXT+10(2) 6M7D CCOFF 6MC= LDX 6 CPLEV(2) 6MWW LDN 1 3 6NBG CALL 4 TCLEAN [ CLEAN UP ON ABANDONING THE COMMAND 6NW6 BRN READLQ 6P*Q [ 6PTB [ 6Q*2 QENTRY16 [ ENDIFREC - A SPECIAL ENDREC FOR 6QSL NGN 0 2 [ THE 'IF' COMMAND WHICH ALSO 6R#= ANDS 0 EXT+9(2) [ CLEARS UP BLOCKS 6RRW LDN 0 2 6S?G BRN SCRAP 6SR6 [ 6T=Q NOTM LDN 0 5 6TQB DCH 0 EXT+10(2) 6W=2 BRN READL 6WPL [ 6X9= [ PROGEND ENTRY POINT PROGEND 6XNW QENTRY15 6Y8G CALL 7 RTP 6YN6 LDX 0 BITS22LS 6^7Q ANDS 0 AMON(3) [LOSE B0 & B1 OF AMON 73Y= CALL 7 TELLHLS 745G [ 74K6 [ MAIN PATH BEGINS * * * * 754Q [ 75JB QENTRY11 [ ENDCOM 7642 CCOFF [CLEAR CC AND OP BITS 767K ...#UNS G400 76?8 ...( 76BR ... HUNTW 2,IUSER,G400BLK [SEARCH FOR EXIT BLOCK 76GB ... BNG 2 XDSK1 [J IF NOT FOUND 76K^ ... LDX 0 A1(2) 76PJ ... BNZ 0 XDSK1 [OR NOT EXIT,BA OR BB 76T7 ... LDX 4 A1+1(2) 76YQ ... FREECORE 2 774* ... DCH 4 EXT+10(2) 777Y ... BRN XDSK2 77?H ...XDSK1 LDX 2 FX2 77C6 ...) 77GW LDN 0 1 782G DCH 0 EXT+10(2) 787N ...#UNS G400 78#W ...XDSK2 78G6 LDXC 4 EXT+8(2) 78^Q LDN 5 0 79FB STOZ EXT+8(2) 79^2 BNZ 5 TERR 7=DL LDX 6 CPLEV(2) 7=Y= LDN 1 3 7?CW CALL 4 TCLEAN [ CLEAN UP AFTER COMMAND 7?XG NOTAXES 7#C6 MHUNTW 2,CPB,CALAS [FIND 1ST CALAS BLOCK 7#H3 ... LDX 1 ALOGLEN(2) 7#LY ... SBN 1 APARAFIR-A1 [X1 - NO. OF CHARS AVAILABLE IN 7#QT ... SLL 1 2 [CPB/CALAS FOR MESSAGE ASSEMBLY 7#WQ LDN 4 0 [NO OF PARAMETER 7*BB ADN 2 APARAFIR 7*W2 LDX 3 2 [1ST CONVERSION POSITION 7B*L SMO FX2 7BT= STOZ EXT+2 [ZEROISE COUNT OF CHARS CONVERTED 7C#W WAD LDX 7 0(2) [LOAD 1ST WORD OF PARAM 7CSG ADN 4 1 [ADD 1 TO NO OF PARAM 7D#6 LDX 6 7 [LOAD 1ST WORD IN X6 7DRQ ANDN 7 #7777 [ISOLATE NO OF CHARS 7F?B ADN 7 7 7FR2 SRL 7 2 [ISOLATE NO OF WORDS IN PARAM 7G=L ADX 2 7 [UPDATE POINTER TO NEXT PARAM 7GQ= BPZ 6 UNACCESS [J IF UNACCESSED 7H5^ ... SMO FX1 7HFN ... ERX 6 MINUS1 7HTC ... BNZ 6 WAD [JUMP IF NOT LAST PARAM 7J96 SMO FX2 7JNQ LDX 4 EXT+2 [COUNT OF CHARS TO PRINT 7K8B BZE 4 UNACFIN [JUMP IF NONE 7KN2 SBN 4 1 [ONE LESS BECAUSE OF SEPARATOR 7L7L OUTPARAM 4,APARAFIR,CPB,CALAS 7LM= MONOUT APAC [MONITORING FILE TRANSFER 7LR7 MHUNTW 2,CPB,CALAS 7LX4 LDX 6 MINUS1(1) 7M2^ STO 6 APARAFIR(2) 7M6W UNACFIN 7MLG READLQ 7N66 LDX 2 FX2 7N?# HUNTW 3,ADATA,CREADL 7NDG BPZ 3 READL 7NKQ LDX 7 CPLEV(2) 7P5B BNZ 7 READL [ CONTINUE IF NOT AT TOP LEVEL 7PK2 LDX 7 CONTEXT(2) 7Q4L ANDN 7 1 7QJ= BNZ 7 READL [ OR IF IN USER CONTEXT 7R3W LDCT 7 #600 7RHG ANDX 7 CONTEXT(2) 7S36 BNZ 7 VSOP [ ABANDON JOB IF SYSTEM ISSUED 7SGQ LDX 7 CONTEXT(2) 7T2B ANDN 7 #20 7TG2 BNZ 7 VSOP [ OR IF FROM OPS CONSOLE 7TPS QENTRY10 7T^L READL 7WF= LDX 2 FX2 7WYW LDCH 4 EXT+10(2) [LOAD TYPE OF UP 7XDG LDX 5 JOBEVENTS(2) 7XY6 BPZ 5 READA 7YCQ ACROSS COMPROB,1 [J IF BREAKIN DETECTED 7YXB [ 7^C2 [ 82B= READA 82HD HUNTW 3,ADATA,CREADL 82NL BPZ 3 READ 82TW LDX 0 CONTEXT(2) 83*G ANDN 0 4 83T6 BZE 0 READ 84#Q LDX 4 CPLEV(2) 84SB BNZ 4 READ 84WK ...#UNS G400 84YS ...( 8533 ... CALL 7 XDSKFREE 855= ... BRN WAIT 857F ... ISSUFINB 859N ...) 85#2 WAIT ACROSS COMPROB,4 [J TO WAIT ROUTINE 85RL [ 86?= [ 86QW QENTRY2 87=G READ 87Q6 #SKI K6ALLGEO>99-99 889Q TRACE ACTCHCH(2),ACTCHCH 88PB LDX 6 ACTCHCH(2) [LOAD CHAPTER CHANGE COUNT 8992 STOZ ACTCHCH(2) [CLEAR IT 89NL MPY 6 CHAPTIME [CONVERT TO 'BEATS' 8=8= DVR 6 BEATTIME [CONVERT TO MILLISECS 8=MW LDX 6 CONTEXT(2) 8?7G SRC 6 2 8?M6 BNG 6 NUSER [J IF AT NO USER CONTEXT 8#6Q CJOBLOCK 3 8#LB ANDN 6 #2000 8*62 BZE 6 NPISSUE [J NOT PROGRAM ISSUED 8*KL LDN 6 0 8B5= SBSC 7 APROGTIME+1(3) 8BJW SBS 6 APROGTIME(3) [STEP DOWN PROGRAM TIME 8C4G NPISSUE 8CJ6 ADSC 7 HTIMEJ+1(3) 8D3Q ADS 6 HTIMEJ(3) [STEP JOB TIME USED 8DHB LDXC 7 HTIMEJ+1(3) 8F32 LDX 6 HTIMEJ(3) 8FGL TXL 7 ATIMEJ+1(3) [TEST IF JOBTIME UP 8G2= TXL 6 ATIMEJ(3) 8GFW BCS NOTUP [J IF NOT 8G^G TESTINBRK NOTUP [J. IF INHIBITBRK BIT IS SET 8H2D LDCH 0 EXT+10(2) 8H3B SBN 0 2 8H4# BZE 0 NOTUP [IGNORE IF IN "IF" ETC. 8H5= LDN 0 COMDAT+CJTEX 8H92 STO 0 AWORK1(2) 8H#Q LDX 4 GSIGN 8HDG CALL 7 SEEKLEV [LOOK FOR WE JTEX 8HJ= BRN NOWJT 8HN2 BRN XINTISS [J IF I/I LEVEL FOUND 8HRQ NOWJT 8HXG LDN 5 0 8J3= LDX 6 JOBTIME 8J72 LDX 1 FX1 8J=Q LDX 2 FX2 8JBG LDX 0 CONTEXT(2) 8JG= BNG 0 TIMINC [J IF SYS ISSUED 8JL2 ANDN 0 #10 8JPQ BNZ 0 TIMINC [J IF MOP 8JTG LDN 5 1 8J^= LDN 6 10 8K52 TIMINC 8K8Q MPY 6 THOUSAND(1) 8K#G FJOCA 3,2 8K*6 LDX 4 HTIMEJ+1(3) [BEFORE UPDATING ALLOWED TIME FOR 8K*Q STO 4 ATIMEJ+1(3) [WE JTEX ACTION SET ALLOWED TIME TO 8KBB LDX 4 HTIMEJ(3) [TIME USED - EDITOR MAY TAKE A 8KC2 STO 4 ATIMEJ(3) [LONG TIME TO TIDY UP AFTER DETECTING 8KCL [JT EXCEEDED - B1319 8KD= ADSC 7 ATIMEJ+1(3) 8KJ2 ADS 6 ATIMEJ(3) 8KMQ HLSINFORM XJTBR,JOBTIME,JOBNO(2) 8KRG XJTBR 8KX= BZE 5 NCHJTEX [J IF SYS ISSUED OR MOP 8L32 JBS TABAN,2,EXJTEX [J IF JTEX HAS ALREADY HAPPENED 8L6Q NCHJTEX 8L=G BZE 5 NSETJT 8LB= BS 2,EXJTEX 8LG2 NSETJT 8LKQ CALL 7 SEEKLEV [LOOK FOR WE JTEX AGAIN 8LPG BRN NOWJT1 8LT= BRN NOWJT1 [I/I LEVEL FOUND 8L^2 MONOUT JOBTEX 8M4Q LDN 5 0 8M8G BRN NOWFIN [GO TO OBEY WE COMMAND 8M#= XINTISS 8MD2 LDX 2 FX2 8MDY LDX 0 CONTEXT(2) [IF MOP ALLOCATE MORE TIME 8MFW ANDN 0 #10 8MGS BNZ 0 NOWJT 8MHQ LDN 0 0 8MMG BRN X24PLUS [ISSUER AT I/I LEVEL 8MR= NOWJT1 8MX2 LDX 1 FX1 8N2Q LDX 2 FX2 8N6G LDX 0 CONTEXT(2) 8N== BNG 0 XSYSJT [ J IF SYS ISSUED 8NB2 ANDN 0 #10 8NFQ BZE 0 TABAN [J IF NOT MOP 8NKG XSYSJT 8NP= MONOUT JOBTEX 8NT2 NOTUP 8P#L NUSER 8PS= LDX 2 FX2 8Q?W # 8QRG [ THIS SECTION CHECKS THAT THE MAXIMUM COMMAND PROCESSOR LEVEL HAS 8R?6 [ NOT BEEN EXCEEDED 8RQQ # 8S=B LDX 4 CPLEV(2) 8SQ2 SBN 4 COMLEVMAX+1 8T9L BNG 4 WX [J IF MAX. LEVEL NOT REACHED 8T?J ...#UNS G400 8T*G ...( 8TCD ... TESTHKN XDSK10 8TFB ... SBN 4 3 8TH# ... BNG 4 WX 8TK= ...XDSK10 8TM8 ...) 8TP= LDX 7 MAX(1) 8W8W RABAND [ TO ABANDON THE JOB 8WNG ACROSS COMPROB,3 8X86 TABAN 8XMQ LDX 7 TIM(1) 8Y7B BRN RABAND 8YM2 WX 8^6L LDX 7 GSIGN 8^L= ORS 7 EXT+9(2) 925W ERS 7 EXT+9(2) [SET TO PAPER TAPE 92KG HUNTW 3,ADATA,CREADL 95H= BPZ 3 PTOPA 95MN LDX 5 CONTEXT(2) 95S6 ANDN 5 #20 95YJ BZE 5 T [J IF NOT OP CONSOLE 9652 LDX 4 CPLEV(2) [LOAD CPL 969D BZE 4 SWAP [J IF AT LEVEL 0 96*W T MHUNTW 3,CPB,CALAS 96GG LDX 4 CPBCPLEV(3) 9726 BNG 4 PCOM [BRANCH IF COMMAND WITHIN COMMAND 9739 ...#SKI G286&1 974# ...( 975C ... LDX 2 FPTR(3) [ => CLB 976G ... LDX 2 FPTR(2) [ SEE IF CLB POINTS TO IUSER 977K ... LDX 0 ATYPE(2) 978N ... SRL 0 12 979R ... SBN 0 IUSER+HULL 97=W ... BNZ 0 XCCS [ BRN IF IUSER DOESN'T EXIST 97?^ ... LDEX 7 A1(2) [ SIZE OF IUSER BLOCK 97*4 ... ACROSS MULTCOMM,2 [ NOT ENOUGH ROOM IN COMPRO 97B7 ...XCCS 97C= ... LDX 2 FX2 97D* ...) 97FQ LDX 4 CPBFSD(3) 97^B BPZ 4 MACREC [J IF MACRO FILE 98F2 LDX 7 CONTEXT(2) 98YL ANDN 7 #10 99D= BZE 7 READLZ 99N4 TESTINBRK XINBRKSET 99XW LDCT 3 #100 9=CG ANDX 3 EXT+11(2) 9=X6 BNZ 3 NOTIME [J IF MULTILINERY 9?BQ OUTPAR TIMENOW 9?WB MAT 9#B2 COMREADY READL 9#TL SWAP 9**= LDX 7 GSIGN 9*SW BRN T2 9B#G NOTIME 9BS6 OUTNULL 9C6H READY READL 9CDY LDX 7 GSIGN 9CR* BRN T2 9D5Q XINBRKSET 9DD7 GEOERR 0,INBRKSET 9DQL MACREC 9F== LDN 7 2 9FPW ANDX 7 CPBPROGLEV(3) 9G9G BZE 7 NODEL [J IF NOT WITHIN DELIMITERS 9GP6 PHOTO 7 [ PREPARE TO COORDINATE 9H8Q DOWN GOTO,2 [TO SEARCH FOR STOPPER 9HNB TESTMOVE 7,NODEL 9J82 MHUNTW 3,CPB,CALAS 9JML NODEL 9K7= LDX 7 GSIGN 9KLW ANDX 7 CPBPROGLEV(3) [LOAD CARD/PT INDICATOR 9L6G ADDREC 3,4 [UPDATE RECORD PTR. 9LL6 READ 9M5Q T2 9MKB MHUNTW 2,FILE,FRB [FIND FILE READ BLOCK 9N52 LDX 5 A1(2) [LOAD RECORD HEADER 9NJL BNZ 5 RENAME [J IF NOT TERMINATION OF FILE 9P4= ACROSS GOTO,3 [ ELSE EXIT FROM MACRO 9PHW RENAME 9Q3G SBN 5 2 [TWO WORD RECORD HDR 9QH6 [NOT ALL CHARS IN LAST WORD ARE SIG. 9R2Q SLL 5 2 9RGB LDX 4 A1+1(2) 9S22 SRL 4 22 9SFL BZE 4 N1 9S^= SBN 5 4 [TAKE OFF 4 CHARS FOR LAST WORD 9TDW ADX 5 4 [ADD IN NO. SIG CHARS IN LAST WORD 9TYG N1 STO 5 A1(2) 9WD6 NAME 2,ADATA,CREADL 9WXQ LDX 2 FX2 9XCB BNG 7 PTOPB [J IF GRAPHIC FILE 9XX2 LDX 7 GSIGN 9YBL ORS 7 EXT+9(2) 9YW= ERS 7 EXT+9(2) [DENOTES SHIFT FILE 9^*W BRN PTOP 9^TG READLZ =2*6 RDLCHECK =2SQ MHUNTW 3,ADATA,CREADL =3#B LDX 4 A1(3) =3S2 LDN 7 1 =4?L WOP =4R= BNG 4 PERIDIS [J IF PERIPHERAL DISENGAGED =5=W LDCH 5 JSOURCE1(2) =5QG ERN 5 3 =6=6 BNZ 5 PTOP [J IF NOT CARDS =6PQ QENTRY4 =79B PTOPA LDX 7 GSIGN =7P2 PTOPB ORS 7 EXT+9(2) =88L PTOP =8N= MHUNTW 3,ADATA,CREADL =97W LDX 4 A1(3) ==76 BNG 4 PBM ==8T BNZ 4 PTOPF ===J LDCT 0 #100 ==#? ANDX 0 EXT+11(2) ==B2 BZE 0 PBM [J IF NOT MULTI-LINE ==CP LDN 0 #20 ==FD DCH 0 CPDATA(3) ==H7 LDN 0 1 ==JW STO 0 A1(3) ==LQ PTOPF ==M# ...#SKI G286&1 ==MW ...( ==ND ... LDCH 0 CPDATA(3) ==P2 ... SBN 0 #30 [ '(' ==PJ ... BNZ 0 XCCS1 [ NO ==Q6 ... LDCT 0 #100 ==QN ... ANDX 0 EXT+11(2) ==R= ... BNZ 0 XCCS1 [ J IF MULTILINERY ==RS ... LDX 0 A1(3) ==SB ... SBN 0 4 ==SY ... BNG 0 XCCS13 [ IF < 4 CHARS THEN NOT ST/STOPPER ==TG ... HUNTW 2,CPB,CALAS ==W4 ... BNG 2 XCCS13 [ NONE ==WL ... LDX 0 CPBSTART(2) ==X8 ... SBX 0 CPDATA(3) ==XQ ... BZE 0 XCCS1 [ BRN IF STARTER ==Y# ... LDX 0 CPBSTOP(2) ==YW ... SBX 0 CPDATA(3) ==^D ... BZE 0 XCCS1 [ BRN IF STOPPER =?22 ...XCCS13 =?2J ... LDX 7 A1(3) =?36 ... SRL 7 2 =?3N ... ADN 7 4 [ NO OF WORDS IN CREADL + 3 OR 4 =?4= ... ACROSS MULTCOMM,1 [ NEW CHAPTER FOR MAIN CODE =?4S ...XCCS1 =?5B ...) =?6B ACROSS ALAS,1 =?L2 [ =#5L [ MAIN PATH ENDS * * * * =#K= [ =*4W NOW =*JG SMO FX2 =B46 LDX 6 CPLEV =BHQ LDN 5 1 [SET MKR - RETURN TO LOWEST LEVEL =C3B BRN NOWFIN =CH2 TERR =D2L MHUNTW 3,CPB,CALAS =DG= LDX 4 CPBFSD(3) =D^W BNG 4 X24 [J IF NOT M.D.F. =FFG LDX 4 CPBPROGLEV(3) =F^6 ANDN 4 1 [ISOLATE DELIM BIT =GDQ BZE 4 X24 =GYB DOWN GOTO,2 =HD2 X24 =HXL LDN 0 COMDAT+CWHEN =J7D X24PLUS =JC= STO 0 AWORK1(2) [THE WHENEVER SEARCH =JWW LDX 4 GSIGN [SET MKR TO OMIT SEARCH FOR SPEC I.IS =KBG CALL 7 SEEKLEV =KW6 BRN NOW [NO WHEN.LEV./INT.ISS LEVEL FOUND =L*Q BRN NOWFIN =LTB LDN 5 0 [SET WHENEVER MARKER =M*2 NOWFIN =MSL LDN 1 3 [STORE PARAM FOR CLEANX MACRO =N#= CALL 4 TCLEAN =NRW MHUNTW 2,CPB,CALAS =P?G LDX 4 CPBCPLEV(2) =PR6 X281 LDX 0 MASKJR(1) =Q=Q ANDS 0 CPBFSD(2) =QQB BNZ 5 X285 [J IF NOT WHENEVER LEVEL =R=2 LDX 2 FX2 =RPL WN CALL 7 SETCREADL =S9= BRN PTOPA =SNW X285 BPZ 5 MOPT [J IF REMAIN AT LOWEST LEVEL =T8G BPZ 4 READLQ =TN6 SMO FX2 =W7Q LDX 4 CPLEV =W97 ...#UNS G400 =W=J ...( =W?^ ... BNZ 4 XDSKW =W*B ... CALL 7 XDSKFREE =WBR ... BRN WAIT =WD8 ... ISSUERR =WFK ...XDSKW =WH2 ...) =WJC ...#UNS G400 =WKS ...#SKI =WMB BZE 4 WAIT =WX8 LDX 4 CPBCPLEV(2) =X72 LDX 3 FPTR(2) [ CLEAN UP =XLL CALL 5 UPLEV [S/R TO GO UP 1 C.P.LEVEL =XRS LDX 0 AWORK1(2) =X^2 BZE 0 PCOMJT [J IF JT EX =Y6= ISSUERR =YKW MOPT SMO FX2 =^5G LDX 4 CONTEXT =^K6 BNG 4 READLQ [J IF SYS ISS JOB ?24Q LDX 5 4 [KEEP COPY OF CONTEXT ?2JB ANDN 4 12 ?342 BZE 4 POSPTCR [J IF NOT MOP/OFFLINE ?3HL ERN 4 4 ?43= BZE 4 READLQ [J IF OFFLINE ?4GW LDX 4 CPBFSD(2) [LOAD MACRO INDICATOR ?52G BNG 4 READLQ [J IF NOT MACRO ?5G6 LDX 4 GSIGN ?5^Q SMO FX2 ?6FB ORS 4 JOBEVENTS ?6^2 BRN READLQ ?7DL POSPTCR ?7Y= BZE 6 TERM [J IF CPLEV IS ZERO ?8CW LDN 7 1 ?8XG ANDX 7 5 ?9C6 BNZ 7 READL [J IF IN USER CONTEXT ?9WQ ACROSS COMPROB,5 [ TO AB MDF IN NO-USER CONTEXT ?=BB TERM LDN 4 32 ?=W2 ANDX 4 5 ??*L BZE 4 VSOP [J IF OP CONSOLE ??T= ACROSS ENGAGE,30 ?##W [ THIS SECTION DEALS WITH ANY UNACCESSED PARAMETERS ?#SG [ ?*#6 [ CONVERSION OF UNACCESSED PARAMETER NOS TO CHARACTERS ?*RQ [ AND PUTTIMG THEM IN CALAS BLOCK STARTING AT APARAFIR.0 ?B3J ...[ ****CAUTION**** X1 DOES NOT = FX1 ?B?B UNACCESS ?BR2 LDN 0 2 ?C=L LDX 6 4 ?CD? ... SMO FX1 ?CKY ... DVS 5 TEN ?CRK ... BZE 6 UNAC1 ?C^= ... ADN 0 1 ?D6X ...UNAC1 ?D#J ... SBX 1 0 ?DG9 ... BPZ 1 UNAC2 ?DMW ... GEOERR 0,UNACMESS [MESSAGE GOING BEYOND END OF BLOCK ?DTH ...UNAC2 ?F38 ... BZE 6 UNAC3 ?F96 DCH 6 0(3) ?FNQ BCHX 3 £ ?G8B ...UNAC3 ?GN2 DCH 5 0(3) ?H7L BCHX 3 £ ?HM= LDN 5 #34 ?J6W DCH 5 0(3) ?JLG BCHX 3 £ ?K66 SMO FX2 ?KKQ ADS 0 EXT+2 [ KEEP TOTAL NO OF CHARS TO BE OUTPUT ?L5B BRN WAD ?LK2 PERIDIS ?LLJ LDCT 0 #100 ?LN6 ANDX 0 EXT+11(2) ?LPN BZE 0 NMLENDP [J IF NOT MULTILINEARY ?LR= LDCT 0 #100 ?LSS ERS 0 EXT+11(2) ?LWB LDN 0 1 ?LXY ORS 0 EXT+9(2) [SET "VERB" BIT ?L^G COMERR ERMLENDP ?M34 NMLENDP ?M4L LDCH 5 JSOURCE1(2) ?MJ= BZE 5 PTORCR [J IF PTR ?N3W SBN 5 3 ?NHG BNZ 5 PFIN ?P36 PTORCR ?PGQ FREEPER ?Q2B PFIN ?QG2 VFREEW ADATA,CREADL ?Q^L VSOP ACROSS LOGOUT,7 ?RF= PCOM LDX 2 FPTR(3) [GET PTR TO CLB ?RYW CALL 5 UPLEV [GO UP A C.P.LEVEL ?S8N PCOMJT ?SDG LDX 5 EXT+11(2) ?SY6 BPZ 5 PCOM1 [J IF NOT SYS.ISSUED ?TCQ ANDN 5 #77 ?TXB TXU 5 CPLEV(2) ?WC2 BCS PCOM1 [J IF SYS.ISS MACRO NOT FINISHED ?WWL LDX 5 MASKSSI(1) [LOSE BIT ?XB= ANDS 5 EXT+11(2) ?XTW PCOM1 ?Y*G SLL 4 1 ?YT6 BPZ 4 PCOM2 [J IF ISSUCOM,NOT ISSUCOMB ?^#Q ISSUFINB ?^SB PCOM2 #2#2 ISSUFIN #2RL # #3?= ...#UNS G400 #3QW ...( #4=G ...# SUBROUTINE USED BY INSTALLATION HOOKS #4Q6 ...# CLEARS HOOK LEVEL IF NEED BE #59Q ...XDSKFREE #5PB ... MHUNT 2,CPB,CALAS #692 ... LDX 4 CPBCPLEV(2) #6NL ... SLL 4 1 #78= ... BPZ 4 XDSKWAIT [J FOLLOW NORMAL PATH #7MW ... SBX 7 FX1 [CLEAR HOOK LEVEL #87G ... LDX 3 FPTR(2) #8M6 ... FREECORE 2 #96Q ... FREECORE 3 #9LB ... LDN 0 1 #=62 ... SBS 0 CPLEV(2) #=KL ... UNSETHK #?5= ... ADX 7 FX1 #?JW ... EXIT 7 1 ##4G ...XDSKWAIT ##J6 ... EXIT 7 0 #*3Q ...# #*HB ...) #GCL #END ^^^^ ...46130750000300000000