(George Source)
Macros used: ACROSS, BXGE, GEOERR, JANAL, JBC, MENDAREA, MHUNTW, MONOUTX, ON, OUTMESSX, OUTNULL, OUTPARAM, OUTPERA, SEG, SEGENTRY, SETUPCORE, TRACE, UP, VFREEW
22=X ... SEG ERROR,,CENT(COMMAND PROCESSOR),,G400 22HS ...[ 22SP ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 235L ...[ 23BH ...#UNS G400 23MD ...# THIS CHAPTER IS MODIFIED FOR G3PLUS-IH MK2 23YG SEGENTRY K1ERROR,SENTRY1 24D6 SEGENTRY K2ERROR,SENTRY2 24XQ SEGENTRY K3ERROR,SENTRY3 257J ... SEGENTRY K5ERROR,SENTRY5 [DOHIER MACRO 25CB # THIS SEGMENT IS ENTERED BY 4 MACROS,ERROR AND ERRORX WHICH COME 25X2 # DOWN,AND COMERR AND COMERRX WHICH COME ACROSS.THIS SEGMENT LOOKS 26BL # FOR A UNI-BLOCK TO FIND THE PARAMETER NUMBER AND COMPILES A 26W= # MESSAGE WHICH SAYS 'IN PARAMETER N'.IF THERE IS NO UNI BLOCK 27*W # THE MESSAGE IS OUTNULLED.IF A SUB-MESSAGE WAS SPECIFIED IN 27TG # THE MACRO,THIS IS OUTPUT.IF NO SUB-MESSAGE,IT IS ASSUMED THAT 28*6 # IF THERE IS A UNI-BLOCK IT CONTAINS A SUB MESSAGE,OTHERWISE 28SQ # THIS MESSAGE IS OUTNULLED.THE COMMAND PROCESSOR HIERARCHY IS 29#B # ALSO OUTPUT.THUS THE THREE CONSTITUENT PARTS AFOREMENTIONED 29S2 # PLUS THE MAIN MESSAGE SPECIFIED IN THE MACRO FORM THE WHOLE 2=?L # MESSAGE 2=R= # 2?=W # 2?QG # 2#=6 # 2#PQ # THIS SECTION COMPILES THE COMMAND PROCESSOR HIERARCHY UP TO AND 2*9B # INCLUDING COMMAND PROCESSOR LEVEL 1. WITH A BROKEN IN ON LINE 2*P2 # JOB,UP TO AND INCLUDING THE TOP BREAK IN LEVEL .WITH ALL OTHER 2B8L # CASES THE COMPLETE HIERARCHY. 2BN= # 2C7W # 2CMG # 2D76 # THIS ENTRY IS FOR THE SPERROR MACRO. THIS IS A SPECIAL PURPOSE 2DLQ # MACRO TO ASSEMBLE THE HIERARCHY,EXCEPT THE COMMAND AT THE LOWEST 2F6B # LEVEL, AS %A IN A GMON/ASET BLOCK.THE ERROR BIT IS ALSO SET. THIS 2FL2 # MACRO IS FOR USE BY THE COMERR COMMAND 2G5L # 2GK= SENTRY3 2H4W LDX 4 GSIGN 2HJG STO 4 EXT+3(2) [STORE SPERROR MARKER 2J46 LDN 4 0 2JHQ BRN SP1 2JJM ...#UNS G400 2JKJ ...#SKI 2JLF ...( 2JMB ...SENTRY5 2JN? ... BRN (GEOERR) 2JP8 ...) 2JQ5 ...#UNS G400 2JR2 ...( 2JRX ...# ENTRY FOR DOHIER MACRO 2JSS ...SENTRY5 2JTP ... LDX 4 GSIGN 2JWL ... ORN 4 1 2JXH ... STO 4 EXT+3(2) [MARKER FOR DOHIER 2JYD ... LDN 4 0 2J^* ... BRN SP1 2K2= ...) 2K3B SENTRY1 2KH2 LDN 4 1 [MARKER FOR ERROR/ERRORX 2L2L STO 4 EXT+3(2) 2LG= BRN START 2L^W SENTRY2 2MFG STOZ EXT+3(2) [MARKER FOR COMERR/COMERRX 2M^6 START 2NDQ LDX 4 EXT(2) 2NYB BPZ 4 WOOP 2PD2 GEOERR 1,NOMESSIN [GEOERR IF NO COMERR PARAMETERS 2PXL WOOP 2QC= LDN 4 1 [ADD 1 AS FIRST LEVEL IS CPL 0 2QWW SP1 ADX 4 CPLEV(2) [X4=NO OF POSS ENTRIES IN HIERARCHY 2RBG SLL 4 2 [ALLOWS 4 WORDS FOR EACH LEVEL 2RL# ... LDN 6 0 2RW6 ... JBC NCCCOM,2,EXCANISS [J IF NOT CC 2S5Y ... LDCT 6 #400 2S*Q ...NCCCOM 2SKJ ... JBC NOPCOM,2,EXOPCOM [J IF NOT OP 2STB ... SRL 6 1 2T58 ... ORX 6 GSIGN 2T*2 ...NOPCOM 2TJS ... STO 6 AWORK2(2) [REMEMBER FOR LATER 2TSL ... BZE 6 N1 2W4D ... ADN 4 5 [ALLOW ENOUGH FOR 'CC OP' 2W#= N1 ADN 4 4 [ADD 4 FOR 'ON UNIT ?' 2WRW SETUPCORE 4,3,COMDAT,CINC [GET AND NAME A COMDAT CINC BLOCK 2X?G #SKI ADELO 2XR6 ( 2Y=Q ... JANAL NVB [J IF STILL PROCESSING COMMAND 2YQB ... BRN NVERB [J IF 'VERB-BIT' CLEAR 2^=2 ...NVB LDX 6 EXT+3(2) 329= BNZ 6 NCOME [J IF NOT 'COMMERRR' 32F4 ... LDN 0 1 32NW ERS 0 EXT+9(2) [ELSE CLEAR BIT 338G NCOME MHUNTW 2,CLB 33N6 LDN 0 4 347Q LDX 5 VERB(1) 34MB LDX 6 VERB+1(1) 3572 STO 0 ANUMCHA(2) [COUNT OF 4 35LL STO 5 CLBFIR(2) [& "VERB " IN 1ST CLB 366= STO 6 CLBFIR+1(2) 36KW LDX 2 FX2 375G NVERB 37K6 ) 384Q LDN 0 0 [ZEROISE COUNT OF CHARACTERS 38JB STO 3 AWORK1(2) 3942 ADN 3 A1 [POINTER TO FIRST WORD OF IN BLOCK 39HL LDX 4 EXT+3(2) 3=3= BPZ 4 X1 [J IF NOT SPERROR MACRO 3=GW MHUNTW 2,CPB,CALAS [TO OMIT LOWEST LEVEL OF HIERARCHY 3?2G LDN 0 0 3?G6 X1 LDX 2 FPTR(2) [ THIS SECTION 3?^Q LDX 4 ATYPE(2) [ SEARCHES FOR 3#FB SRL 4 12 [ THE NEXT 3#^2 ERN 4 CPB+CALAS [ CPB/CALAS 3*DL BNZ 4 X1 [ BLOCK 3*Y= LDX 7 2 [STORE POINTER TO CPB/CALAS BLOCK 3BCW LDEX 6 CPBCPLEV(2) 3BXG LDCT 5 #400 3CC6 ANDX 5 CPBCPLEV(2) 3CWQ BNZ 6 SPLOD [JUMP IF NOT CPL 0 3DBB SMO FX2 3DW2 LDX 4 CONTEXT [LOAD THE CONTEXT BITS 3F*L BNG 4 NOUGHT [J IF A SYSTEM ISSUED JOB 3FT= ANDN 4 4 3G#W BNZ 4 NOUGHT [JUMP IF OFFLINE JOB 3GSG BRN PCO 3H#6 SPLOD BNZ 5 PCO [JUMP IF INTERNALLY ISSUED 3HRQ LDX 5 CPBFSD(2) [LOAD MACRO INDICATOR 3J?B BPZ 5 PCO [JUMP IF MACRO 3JR2 LDN 6 0 [PRETEND CPL 0 SINCE BREAK IN 3K=L PCO 3KQ= LDX 2 FPTR(2) [POINTER TO LINE BUFFER 3L9W LDX 5 ANUMCHA(2) 3LPG ADN 2 CLBFIR [POINTER TO 1ST CHAR 3M96 LDX 4 WIN(1) [THIS WORD SAYS ' NI ' 3MNQ LDN 1 4 3N8B X10 DCH 4 0(3) [ THIS SECTION 3NN2 BCHX 3 £ [ DEPOSITS THE 3P7L ADN 0 1 [ CHARACTERS ' IN ' 3PM= SRL 4 6 [ IN THE COMDAT/CINC 3Q6W BCT 1 X10 [ BLOCK 3QLG LDX 1 FX1 [RESTORE X1 3R66 BRN X2 [GO TO STORE CHARACTERS OF VERB 3RKQ X5 LDCH 4 0(2) [THIS SECTION LOOKS FOR THE 3S5B BCHX 2 £ [TERMINATION OF THE VERB 3SK2 TXU 4 SPACE(1) 3T4L BCS XOP 3TJ= DCH 4 0(3) [DUMP SPACE CHARACTER AS SEPARATOR 3W3W SMO FX2 3WHG LDXC 4 AWORK2 3X36 BCC X4 [J IF NO0 'CANCEL' 3X=Y ... SLL 4 1 3XGQ SMO FX2 3Y2B ... STO 4 AWORK2 [CLEAR MARKER 3YG2 BCHX 3 £ [AND GO ROUND AGAIN 3Y^L ADN 0 1 3^F= BCT 5 X6 3^YW GEOERR 1,NOTCANCL 42DG ...X6 ORX 0 GSIGN 42Y6 ... BRN X2 [JUMP OUT NOW 43XB X3 LDCH 4 0(2) [ THIS SECTION 44C2 BCT 5 £ 44WL BCHX 2 £ [ READS THROUGH 45B= TXU 4 SPACE(1) [ THE LABEL 45TW BCS X3 [ IF PRESENT 46*G X2 LDCH 4 0(2) [ THIS SECTION 46T6 BCT 5 £ 47#Q BCHX 2 £ [ THROWS AWAY 47SB TXU 4 SPACE(1) [ SPACES UNTIL 48#2 BCC X2 [ IT ENCOUNTERS 48RL BNG 0 X7 [IF REPEATING FOR CANCEL, 49?= [DON'T TEST FOR LABEL 49QW TXL 4 TEN(1) [ A VERB OR 4==G BCS X3 [ A LABEL 4=Q6 X7 ADN 5 1 4?9Q XOP DCH 4 0(3) [ THIS SECTION 4?PB BCHX 3 £ [ DEPOSITS THE VERB 4#92 ADN 0 1 [ IN THE COMDAT/CINC 4#NL BCT 5 X5 4*8= X4 LDX 2 7 [RESTORE POINTER TO CPB/CALAS BLOCK 4*MW BNZ 6 X1 [J IF NOT CPL 0 4B7G SMO FX2 4BM6 LDX 4 CONTEXT [LOAD CONTEXT 4C6Q ANDN 4 32 4CLB BZE 4 NOUGHT [J IF NOT PAPER TAPE OR CARD READER 4D62 LDN 2 UNIT(1) [ THIS SECTION MOVES 'ON UNIT' 4DKL MVCH 2 9 [ TO THE COMDAT/CINC 4F5= ADN 0 9 [ BLOCK 4FJW #SKI 1<CLUSPROPS-1 4G4G ( 4GJ6 LDX 2 FX2 4H3Q LDX 5 CA5(2) [LOAD GEOG NO 4HHB ANDN 5 #77 4J32 MPY 5 MAGIC(1) [MULTIPLY BY 7036875 4JGL LDN 7 7 [COUNT OF 7 4K2= LDN 4 0 4KFW LDN 1 0 4K^G PONT CBD 5 1 [CONVERT CHAR 4LF6 BNZ 1 POGA [J IF NOT ZERO 4LYQ BZE 4 RETA [J IF LEADING ZERO 4MDB POGA LDN 4 1 4MY2 DCH 1 0(3) [DEPOSIT CHAR IN COMDAT/CINC 4NCL ADN 0 1 [UPDATE COUNT 4NX= BCHX 3 £ [UPDATE MODIFIER 4PBW RETA BCT 7 PONT 4PWG LDX 1 FX1 [RESTORE X1 4QB6 ) 4QTQ #SKI CLUSPROPS 4R*B ( 4RT2 LDXC 4 0 [COPY CHAR. COUNT 4S#L LDN 0 0 [CLEAR 'C' 4SS= LDX 2 FX2 4T?W SBX 3 AWORK1(2) 4TRG OUTPERA 4W?6 MHUNTW 1,COMDAT,CINC 4WQQ ADX 3 1 4X=B LDX 7 ACOMMUNE1(2) 4XQ2 LDN 2 ACOMMUNE2(2) 4Y9L POGA LDCH 5 0(2) 4YP= BCHX 2 £ [UPDATE PTR 4^8W DCH 5 0(3) [DEPOSIT IN COMDAT/CINC 4^NG BCHX 3 £ [UPDATE /CINC POINTER 5286 ADN 4 1 [INCREASE COUNT 52MQ BCT 7 POGA 537B BRN N2 53M2 ) 546L NOUGHT 54L= LDXC 4 0 [LOAD COUNT OF CHARS. TO OUTPUT 555W LDN 0 0 [CLEAR 'C' 55KG N2 5656 BNZ 4 X30 [BRANCH IF NOT ZERO 56JQ OUTNULL 574B BRN QUATA 57J2 X30 OUTPARAM 4,A1,COMDAT,CINC [OUTPARAM'IN X IN Y' ETC 583L QUATA 58H= LDX 5 EXT+3(2) 58JS ...#UNS G400 58LB ...( 58MY ... BPZ 5 QUAT [J NOT SPERROR OR DOHIER 58PG ... TXU 5 GSIGN 58R4 ... BCC SP2 [JIF SPERROR MACRO 58SL ... UP [DOHIER EXIT 58W8 ...) 58XQ ...#UNS G400 58^# ...#SKI 592W BNG 5 SP2 [J IF SPERROR MACRO 59GG # 5=26 # 5=FQ # 5=^B # 5?F2 # THE FOLLOWING SECTION FORMS THE SUB MESSAGE 'IN PARAMETER N' 5?YL # AND THEN OUTPARAMS IT.IF NO UNI BLOCK THEN OUTNULLS 5#D= # 5#XW # 5*CG # 5*X6 # 5BBQ QUAT 5BWB LDX 2 FPTR(2) [POINTER TO NEXT BLOCK 5CB2 LDX 5 ATYPE(2) [LOAD TYPE 5CKS ... BXGE 5 CACT,QNULL 5CTL SRL 5 12 5D*= LDN 0 CPB+CALAS 5DSW TXU 5 0 5F#G BCS UNI [J IF NOT CPB/CALAS 5FJ# ...QNULL 5FS6 OUTNULL [OUTNULL BECAUSE NO-UNI BLOCK 5G?Q BRN WICK 5GRB UNI ERN 5 CPB+CUNI 5H?2 BNZ 5 QUAT [J IF NOT UNI-BLOCK 5HQL LDN 4 13 [COUNT OF CHARS 5J== MHUNTW 3,COMDAT,CINC 5JPW LDX 5 JPARNUM(2) [LOAD THE NUMBER OF PARAMETER 5K9G LDN 2 PAR(1) [ADDRESS OF MESSAGE AREA 5KP6 ADN 3 A1 5L8Q MOVE 2 4 [MOVE INTO COMDAT,CINC 5LNB ADN 3 3 [ UPDATE THE 5M82 BCHX 3 £ [ CHARACTER MODIFIER 5MML MPY 5 MAGIC(1) [ TURN INTO DOUBLE LENGTH NUMBER 5N7= LDN 7 7 [COUNT FOR NUMBER OF CHARACTERS 5NLW LDN 1 0 5P6G LDN 0 0 [MARKER FOR ZERO SUPPRESSION 5PL6 PINT CBD 5 1 [CONVERT 5Q5Q BNZ 1 POG [J IF NON ZERO 5QKB BZE 0 RETURN 5R52 POG LDN 0 1 5RJL DCH 1 0(3) [ THIS SECTION STORES 5S4= ADN 4 1 [ THE PARAMETER NUMBER 5SHW BCHX 3 £ [ IN THE COMDAT/CINC BLOCK 5T3G RETURN 5TH6 BCT 7 PINT 5W2Q OUTPARAM 4,A1,COMDAT,CINC [OUTPUT THE SUB MESSAGE 5WGB WICK VFREEW COMDAT,CINC 5X22 # 5XFL # 5X^= # 5YDW # 5YYG # THE FOLLOWING ROUTINE DETERMINES THE SUB-MESSAGE AND OUTPUTS IT 5^D6 # IF NO SUB-MESSAGE OUTNULLS 5^XQ # 62CB # 62X2 # 63BL # 63W= LDX 4 EXT+1(2) [LOAD SUB-MESSAGE INDICATOR 64*W BNG 4 ZY [J IF THERE ISN'T ONE 64TG OUTMESSX 4 65*6 BRN WP 65SQ ZY LDX 2 FPTR(2) [ THIS SECTION 66#B LDX 5 ATYPE(2) 66S2 SRL 5 12 [ A CPB/CALAS 67?L LDN 0 CPB+CALAS [ BLOCK AND EXITS 67R= TXU 5 0 [ IF THERE 68=W BCS NOTCPB [ IS ONE 68QG NULLP OUTNULL 69=6 BRN WP 69PQ NOTCPB 6=9B ERN 5 CPB+CUNI 6=P2 BNZ 5 ZY [J IF NOT UNI BLOCK 6?8L LDX 5 ANUM(2) [LOAD NO OF CHARS 6?N= BZE 5 NULLP [J IF NULL PARAMETER 6#7W BNG 5 NULLP [J IF NO PARAMETER 6#MG ANDN 5 #7777 [RETAIN NO OF CHARS 6*76 OUTPARAM 5,APARA,CPB,CUNI 6*LQ WP 6B6B MONOUTX EXT(2) 6BL2 #SKI K6ALLGEO>99-99 6C5L TRACE EXT(2),COMERR 6CK= SP2 6D4W LDX 6 GSIGN 6DJG ORS 6 EXT+8(2) 6F46 LDX 6 EXT+3(2) 6FG9 ...ZUP 6FHQ BZE 6 WCOMERR [J IF COMERR ENTRY 6G3B ...ZUP1 UP 6GH2 WCOMERR 6H2L #SKI COMPROMK7 6HG= ACROSS COMPRO,11 6H^W #SKI COMPROMK7<1$1 6JFG ACROSS COMPROB,11 6J^6 SPACE #20 6K8Y ...XCOMMA #34 6KDQ TEN +10 6KYB WIN 4H NI 6LD2 MAGIC +7036875 6LXL PAR 13HIN PARAMETER 6MC= UNIT 9H ON UNIT 6MWW #SKI ADELO 6NBG VERB 8HVERB 6NW6 MENDAREA 40,GAPERROR 6P*Q #END ^^^^ ...12205406000100000000