{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: COMPRO867)}}
====== COMPRO867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDREC|ADDREC]], [[george:macro:BS|BS]], [[george:macro:CCOFF|CCOFF]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CJOBLOCK|CJOBLOCK]], [[george:macro:CLEANX|CLEANX]], [[george:macro:COMERR|COMERR]], [[george:macro:COMREADY|COMREADY]], [[george:macro:DOWN|DOWN]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FPCACA|FPCACA]], [[george:macro:FPCAJO|FPCAJO]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREEPER|FREEPER]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETWORD|GETWORD]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:HUNTW|HUNTW]], [[george:macro:ISSUERR|ISSUERR]], [[george:macro:ISSUFIN|ISSUFIN]], [[george:macro:ISSUFINB|ISSUFINB]], [[george:macro:JBS|JBS]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MHUNTX|MHUNTX]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:OUTNULL|OUTNULL]], [[george:macro:OUTPAR|OUTPAR]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PHOTO|PHOTO]], [[george:macro:RDLCHECK|RDLCHECK]], [[george:macro:READ|READ]], [[george:macro:READY|READY]], [[george:macro:RINGTP|RINGTP]], [[george:macro:RVHOOK|RVHOOK]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SWAP|SWAP]], [[george:macro:T|T]], [[george:macro:TESTHKN|TESTHKN]], [[george:macro:TESTINBRK|TESTINBRK]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTRCTP|TESTRCTP]], [[george:macro:TESTTP|TESTTP]], [[george:macro:TRACE|TRACE]], [[george:macro:UNSETHK|UNSETHK]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WORDFIN|WORDFIN]]
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