{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: MONJRNAL850)}}
====== MONJRNAL850 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BSON|BSON]], [[george:macro:CATMASK|CATMASK]], [[george:macro:FCJOB|FCJOB]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:GMONTIDY|GMONTIDY]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFPDCTAB|MFPDCTAB]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MILL|MILL]], [[george:macro:MPROPCON|MPROPCON]], [[george:macro:NAME|NAME]], [[george:macro:NEXTPART|NEXTPART]], [[george:macro:OVER|OVER]], [[george:macro:RESTART|RESTART]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SJCHAIN|SJCHAIN]], [[george:macro:SJCHAINY|SJCHAINY]], [[george:macro:UP|UP]], [[george:macro:VFREEW|VFREEW]]
22FL #SEG MONJRNAL70 [R TERRY
22^= #LIS K0MONFILE>K0MONCHAPS>K0ALLGEO>K0GREATGEO
23DW 8HMONJRNAL
23YG SEGENTRY K1MONJRNAL,SENTRY1
24D6 # THIS SEGMENT IS ENTERED FROM MONFILE TO OUTPUT
24XQ # (PART OF) THE ATEMP MESSAGE TO THE SYSTEM JOURNAL
25CB # IN PACKED MODE
25X2 # SOME DUPLICATION FROM MONFIL IS INEVITABLE, BUT
26BL # IS REDUCED BY USE OF SPECIAL MAROS
26W= #
27*W MFPDCTAB [SETUP PDCTABLE AND LOCAL DEFINES
27TG #
28*6 # FF DEFINES USD FOR CREATION OF PACKED MESSAGES
28SQ #
29#B #DEF PDCPTR=WORK8+1 [CHAR-PTR TO NEXT PDC
29S2 #DEF PTRJNL=WORK8 [PTR TO FPTR OF JNAL BLOCK
2=?L #DEF NCHAR=THISPART [INPUT CHAR PTR IN ATEMP
2=#D ...#SKI JWPHASE4
2=*= ...(
2=B4 ...SCAN LDX 0 GDESTINY(2)
2=BW ... ANDN 0 #2000
2=CN ... BZE 0 SCAN2 [J IF NOT HLS DESTINY
2=DG ... LDN 0 #4000
2=F# ... ANDX 0 0(1)
2=G6 ... BRN SCAN4
2=GY ...SCAN2 SMO FX1
2=HQ ... LDX 0 WJOUR
2=JJ ... ANDX 0 1(1)
2=KB ...SCAN4 BZE 0 SCAN8 [J IF NOT HLS/SJ CATEGORY
2=L8 ... LDCT 0 #40
2=M2 ... ANDX 0 1(1)
2=MS ... BNZ 0 SCAN9 [J IF PACKED
2=NL ...SCAN8 EXIT 4 0 [NOT REQUIRED CATEGORY
2=PD ...SCAN9 EXIT 4 1 [REQIRED CATEGORY
2=Q= ...)
2=R= #
2?=W # RESTARTS: X7 IS ALWAYS A COUNT OF CHARACTERS LEFT
2?QG # THIS S/R SHOULD BE CALLED WE THIS EXPIRES.
2#=6 # IT IS ASSUMED THAT CERTAIN WELL DEFINED WORK WORDS
2#PQ # HAVE BEEN PRIORLY UPDATED - IT OUGHT TO BE POSS.
2*9B # TO RESTART AS IF NOTHING HAD HAPPENED ON EXIT
2*P2 #
2B8L SETJ [ENTRY FROM JOURNAL
2BN= SMO FX2
2C7W STO 2 X2
2CMG LDX 2 FX2
2D76 LDX 3 PTRJNL(2)
2DLQ SBS 3 PDCPTR(2)
2F6B SBS 3 OUTCHAR(2)
2FL2 SBS 3 SAFE(2)
2G5L MHUNTW 1,GMON,ATEMP
2GK= SBS 1 NCHAR(2)
2H4W SBS 1 PARTPTR(2)
2HJG LDX 0 PTRASET(2)
2J46 SBS 0 X2(2)
2JHQ EXIT 6 0
2K3B # NOW RE-RELATIVIZE
2KH2 #
2L2L RESETJ [REENTRY FROM JOURNAL
2LG= MHUNTW 1,GMON,ASET
2L^W MHUNTW 3,GMON,JRNAL
2MFG LDX 2 FX2
2M^6 STO 3 PTRJNL(2)
2NDQ ADS 3 OUTCHAR(2)
2NYB ADS 3 SAFE(2)
2PD2 ADS 3 PDCPTR(2)
2PXL ADN 1 A1
2QC= STO 1 PTRASET(2)
2QWW ADS 1 X2(2)
2RBG MHUNTW 1,GMON,ATEMP
2RW6 ADS 1 PARTPTR(2)
2S*Q ADS 1 NCHAR(2)
2STB LDX 3 OUTCHAR(2)
2T*2 LDX 1 NCHAR(2)
2TSL LDX 4 REMAINS(2)
2W#= LDX 2 X2(2)
2WRW EXIT 6 0
2X?G #
2XR6 RESTART [X3->OUTPUT BLOCK
2Y=Q SBX 6 FX1
2YQB LDX 4 ALOGLEN(3)
2^=2 ADN 4 MORE
2^PL ALTLEN 3,4
329= ADN 7 MORE
32NW ADX 6 FX1
338G EXIT 6 0
33N6 # S/R TO FIND THE SPECIFIED PARAMETER
347Q # X1->ATEMP CHAR POSN
34MB # X3->AOUT CHAR POSN
3572 # EXIT+0 IF ERROR DETECTED
35LL # ON EXIT X2->FIRST WORD OF PARAM /<0 IF NOSUCH
366= # X1+3 UPDATED
36KW # V SET IF PDC'S ARE SPECIAL
375G # X4 PRESUMED COUNT OF CHARS LEFT IN ATEMP
37K6 #
384Q PARAMJ [SJ 'PARAM' - NO JUSIFICATION
38JB BCHX 1 £
3942 SBN 4 1
39HL LDCH 5 0(1)
3=3= SBN 5 #41
3=GW BPZ 5 NOJUS
3?2G SBN 4 1
3?G6 BCHX 1 PARM1
3?^Q PARM1 LDCH 5 0(1)
3#FB SBNC 5 #41
3#^2 BCC NOJUS
3*DL EXIT 0 0 [EXIT +0 IF NOT
3*Y= NOJUS LDX 2 FX2
3BCW LDX 2 PTRASET(2) [-> A1 OF ASET
3BXG TXL 5 0(2)
3CC6 BCS PEXST
3CWQ NGN 2 4095 [HERE IF NO SUCH PARAM
3DBB BRN PEND
3DW2 PEXST BZE 5 PFND [J IF'A'
3F*L PLOOP LDXC 6 2(2)
3FT= BCC PAR1 [J IF ORDINARY PARAM
3G#W SLL 6 1
3GSG BPZ 6 PAR2 [J IF NOT OUTNUM'D
3H#6 BDX 2 PNEXT
3HRQ PAR2 SRL 6 7 [WORD CT IN B6-17
3J?B ANDN 6 4095
3JR2 BUX 6 PAR3 [+1 FOR 1ST WORD
3K=L PAR1 ADN 6 7
3KQ= SRL 6 2
3L9W PAR3 ADX 2 6 [ADD TOTAL LENGTH (WORDS)
3LPG PNEXT BCT 5 PLOOP
3M96 PFND ADN 2 2 [X2->1ST WORD OF PARAM
3MNQ SMO FX2
3N8B LDX 6 PARTPTR
3NN2 LDCT 5 #40
3P7L SMO 6
3PM= ANDX 5 1 [TEST PACK BIT
3Q6W BZE 5 PEND [J IF NOT PACKED
3QLG BCHX 1 £
3R66 SBN 4 1
3RKQ LDCH 5 0(1)
3S5B ERX 5 0(2)
3SK2 ANDN 5 #77
3T4L BZE 5 PEND
3TJ= LDCH 5 0(1)
3W3W PTEST BZE 5 PENDA [J IF NOTJOURN
3WHG SBN 5 JPDNULL
3X36 BZE 5 PENDA [OR NULL
3XGQ ADN 5 JPDNULL-JPDSKIP
3Y2B BZE 5 PENDA [OR SKIP
3YG2 LDX 5 0(2)
3Y^L ANDN 5 #77 [ELSE USE ASET PDC
3^F= BVCI PTEST
3^YW PERR EXIT 0 0
42DG PENDA BVS PEND
42Y6 BVCI £ [ENSURE V SET
43CQ PEND BNG 4 PERR [J IF OVERSPILL
43XB BZE 4 PERR
44C2 ANDX 0 BITS22LS [UNSET V 0/S
44WL EXIT 0 1
45B= WJOUR CATMASK JOURNAL
45TW WSJPK CATMASK JOURNAL,PACKED
46*G #DEF RECHR=A1
46T6 #DEF TCATS=A1+1
47#Q #
47SB TS15LS #77777
48#2 SERR1 +6
48RL 20HPDC'S DON'T TALLY
49?= SERR2 +6
49QW 20HPARAM NOT OUTPARABLE
4==G #
4=Q6 SENTRY1 [FROM MONFILE
4?9Q # OUTPUT TO SYSTEM JOURNAL-PACKED MODE
4?PB [DONE SPECIALLY SINCE INEVITABLY DIFFERENT
4#92 #
4#NL LDN 0 MKASET
4*8= ANDX 0 MARKS(2)
4*MW BNZ 0 SJSET [J IF ASET EXISTS
4B7G #
4BM6 # NO ASET !
4C6Q #
4CLB PAKIN SETNCORE JMESSAGE-A1+1,3,GMON,JRNAL
4D62 MHUNTW 2,GMON,ATEMP
4DKL LDX 0 RECHR(2)
4F5= ANDX 0 HALFTOP [MESSNO/0
4FJW STO 0 JPACKORG(3)
4G4G STOZ JWAITER(3)
4GJ6 LDX 1 FX2
4H3Q LDX 0 ACOMMUNE2(1)
4HHB STOC 0 JJOBNO(3) [FROM MONOUT
4J32 BCC PAK4
4J=S ... BSON EMSBIT,PAK4 [J IF IN EMS
4JGL LDX 0 ACTNUM(1)
4K2= STO 0 JWAITER(3) [IF NONAUT
4KFW PAK4
4K^G ADN 2 RECHR [->1ST PART
4LF6 LDN 7 0
4LF^ ...#SKI JWPHASE4
4LGS ...(
4LHM ... LDX 1 2
4LJG ... LDX 2 FX2
4LK* ... BRN PAK1
4LL8 ...PAK2 LDEX 0 0(1)
4LM3 ... ADN 0 11
4LMW ... SRL 0 2
4LNP ... ADX 1 0 [NEXT PART
4LPJ ...PAK1 CALL 4 SCAN [CHECK CATEGORIES
4LQC ... BRN PAK3 [J IF NOT SJ&PA/HLS&PA
4LR= ... ORX 7 1(1)
4LS5 ...PAK3 LDCT 0 #100
4LSY ... ANDX 0 1(1)
4LTR ...)
4LWL ...#SKI JWPHASE4<1$1
4LXF ...(
4LYQ BRN PAK1
4MDB PAK2 LDEX 0 0(2)
4MY2 ADN 0 11
4NCL SRL 0 2
4NX= ADX 2 0 [NEXT PART
4PBW PAK1 SMO FX1
4PWG LDX 0 WSJPK [SJ AND PACKED?
4QB6 ANDX 0 1(2) [AGAINST CAT WORD
4QTQ SMO FX1
4R*B ERX 0 WSJPK
4RT2 BNZ 0 PAK3 [J IF NOT SJ & PA
4S#L ORX 7 1(2)
4SS= PAK3 LDCT 0 #100
4T?W ANDX 0 1(2)
4THN ...)
4TRG BNZ 0 PAK2 [J IF CONTINUED
4W?6 STO 7 JCATS(3) [SET UP CATEGORY MASK
4WQQ LDN 7 0 [NO CHARS
4X=B BRN SJOIN
4XQ2 #
4Y9L SJSET MHUNTW 3,GMON,ASET
4YP= LDX 7 ALOGLEN(3) [TAKE ASET LENGTH
4^8W MHUNTW 1,GMON,ATEMP
4^NG ADX 7 ALOGLEN(1) [ADD MESSAGE BLOCK LENGTH
5286 ADN 1 A1
52MQ STO 1 PARTPTR(2)
537B ADN 7 JMESSAGE-A1+1 [X7 SHOULD BE NIG ENOUGH
53M2 # AIM TO FIND NUMBER OF PARAMS TO BE SUBST.(MAX)
546L LDN 5 0
54L= LDN 6 0
54M^ ...#SKI JWPHASE4
54PN ...(
54RC ...PACK1 CALL 4 SCAN [CHECK CATEGORIES
54T6 ... BRN PACK2 [J IF NOT SJ&PA/HLS&PA
54WT ... BRN PACK3
54YJ ...)
552? ...#SKI JWPHASE4<1$1
5542 ...(
555W PACK1 LDCT 0 #40
55KG ANDX 0 1(1)
5656 BZE 0 PACK2 [J IF NOT PACKED
56JQ SMO FX1
574B LDX 0 WJOUR
57J2 ANDX 0 1(1)
583L BNZ 0 PACK3 [J IF SJ
58H= BRN PACK2
58R4 ...)
592W PACK5 NEXTPART 1
59GG BRN PACK1
5=26 PACK3 LDEX 4 0(1) [CHAR COUNT
5=FQ ORX 5 1(1) [UNION OF CATEGORIES
5=^B PACK6 LDCH 0 2(1)
5?F2 SBN 0 #25
5?YL BZE 0 PACK4
5#D= SBN 0 #74-#25
5#XW BNZ 0 PACK7
5*CG PACK4 ADN 6 1 [+1 IF % OR $
5*X6 PACK7 BCHX 1 £
5BBQ BCT 4 PACK6
5BWB PACK2 LDCT 0 #100
5CB2 SMO PARTPTR(2)
5CTL ANDX 0 1
5D*= BNZ 0 PACK5 [J IF CONTINUED
5DSW BZE 6 PAKIN [OUT IF NO PARSUBS
5F#G SETUPCORE 7,1,GMON,JRNAL
5FS6 STOZ JWAITER(1)
5G?Q SBN 7 JMESSAGE-A1+1
5GRB ADN 6 3
5H?2 SRL 6 2 [NO OF WORDS FOR PDC'S
5HQL SBX 7 6
5J== STO 5 JCATS(1) [CATEGORY SUM
5JPW LDX 0 ACOMMUNE2(2)
5K9G STOC 0 JJOBNO(1) [FROM MONOUT
5KP6 BCC PIND
5KYY ... BSON EMSBIT,PIND [J IF IN EMS
5L8Q LDX 0 ACTNUM(2)
5LNB STO 0 JWAITER(1) [NONAUT
5M82 PIND
5MML STOZ JMESSAGE(1)
5N7= LDN 3 JMESSAGE(1)
5NLW LDN 4 1(3)
5P6G SMO 6
5PL6 MOVE 3 0 [ZEROIZE PDC AREA
5Q5Q SMO FX2
5QKB STO 1 PTRJNL
5R52 ADX 3 6
5RJL MHUNTW 2,GMON,ASET
5S4= ADN 2 A1
5SHW SMO FX2
5T3G STO 2 PTRASET [FOR PARAM
5TH6 MHUNTW 2,GMON,ATEMP
5W2Q LDX 0 A1(2)
5WGB STO 0 JPACKORG(1) [MESSNO/RUBBISH
5X22 LDN 1 JMESSAGE(1)
5XFL SMO FX2
5X^= STO 1 PDCPTR
5YDW LDN 1 A1(2)
5YYG LDX 2 FX2
5^D6 STO 6 SIGNW(2) [SAVE NO OF WDS FOR PDCS
5^XQ STO 1 PARTPTR(2)
5^^F ...#SKI JWPHASE4
6238 ...(
624X ...PINA CALL 4 SCAN [CHECK CATEGORIES
626L ... BRN PINB [J IF NOT SJ&PA/HLS&PA
628* ... BRN PINC
62=4 ...)
62?R ...#SKI JWPHASE4<1$1
62*G ...(
62CB PINA LDCT 0 #40
62X2 ANDX 0 1(1)
63BL BZE 0 PINB
63W= SMO FX1
64*W LDX 0 WJOUR
64TG ANDX 0 1(1)
65*6 BNZ 0 PINC [J IF SJ&PACKED
65JY ...)
65SQ PINB LDCT 0 #100
66#B SMO PARTPTR(2)
66S2 ANDX 0 1
67?L BZE 0 TIDYP [OUT IF NO MORE PARTS
67R= NEXTPART 1
68=W BRN PINA
68QG PINC LDEX 4 0(1) [CHAR COUNT
69=6 ADN 1 2
69PQ PLACE LDCH 0 0(1)
6=9B SBN 0 #25
6=P2 BZE 0 SUBPL
6?8L SBN 0 #74-#25
6?N= BZE 0 SUBPL [J IF %OR$
6#7W OVER ['NULL' IF SPECIAL PDC
6#MG PLAXT BCHX 1 £
6*76 BCT 4 PLACE
6*LQ PINE LDX 2 FX2
6B6B BRN PINB [GET NEXT PART
6BL2 # SUBSTITUTE PARAMS
6C5L SUBPL CALL 0 PARAMJ
6CK= BRN SJERR [PDC'S DO NOT TALLY!
6D4W BNG 2 PINE [TRUNC IF NONE
6DJG BVSR OVER [J IF MESSAGE KNOWS BEST
6F46 SMO FX2
6FHQ STO 4 REMAINS [A SAVE FOR SETJ
6G3B SMO FX2
6GH2 STO 1 NCHAR
6H2L LDXC 0 0(2)
6HG= BCC PLAXT [J IF NOT DELAYED CONV
6H^W SLL 0 1
6JFG BNG 0 PLAXT [OR 'OUTNUM'
6J^6 LDX 6 2
6KDQ SRL 0 1
6KYB SMO FX2
6LD2 LDX 2 PDCPTR
6LXL DCH 0 0(2) [INSERT PDC
6MC= BCHX 2 £
6MWW SMO FX2
6NBG STO 2 PDCPTR
6NW6 LDX 2 6
6P*Q LDX 5 0(2)
6PTB ANDN 5 #77
6Q*2 ADX 5 FX1
6QSL SMO 5
6R#= LDX 5 PDCTAB
6RRW BZE 5 SJERR2 [J IF NOT OUTPARABLE
6S?G LDX 0 5
6SR6 SLL 5 1
6T=Q BPZ 5 NVARB
6TQB SLC 5 8
6W=2 ANDN 5 #377
6WPL LDX 6 0(2)
6X9= SRL 6 6
6XNW ANDN 6 511 [NO OF PARAMS
6Y8G MPY 5 6
6YN6 BRN TESTD [X6=MAX CHARS
6^7Q NVARB SLC 5 8
6^MB ANDN 5 #377
7272 LDX 6 5
72LL TESTD LDX 5 0
736= ADN 6 3
73KW SRL 6 2
745G SBX 6 7
74K6 BNG 6 PRESS [J IF ROOM
754Q SMO FX2
75JB STO 3 OUTCHAR
7642 CALL 6 SETJ
76HL CALL 6 RESTART
773= CALL 6 RESETJ
77GW PRESS LDCT 0 #100
782G ANDX 0 0(2)
78G6 BZE 0 NOUTP
78^Q BPZ 5 SJERR2
79FB ADN 5 1
79^2 NOUTP ANDN 5 4095
7=DL SBN 5 QUICK
7=Y= BNZ 5 SLOW
7?CW QUICK LDX 5 0(2) [INSERT DIRECT
7?XG SRL 5 6
7#C6 ANDN 5 #7777
7#WQ ADN 2 1
7*BB BZE 5 PLAXT
7*W2 SMO 5
7B*L MOVE 2 0
7BT= ADX 3 5
7C#W SBX 7 5
7CSG BRN PLAXT
7D#6 #
7DRQ SLOW ADX 5 FX1
7F?B SMO FX2
7FR2 STO 3 SAFE
7G=L SMO FX2
7GQ= STO 3 OUTCHAR
7H9W EXIT 5 QUICK
7HPG # RE-ENTRY WITH X7 UNCHANGED
7J96 REJOURN LDX 0 3
7JNQ SMO FX2
7K8B SBX 0 SAFE
7KN2 SBX 7 0
7L7L PDCEND
7LM= LDX 2 FX2
7M6W LDX 4 REMAINS(2)
7MLG LDX 1 PARTPTR(2)
7N66 LDEX 0 0(1)
7NKQ SBX 0 4
7P5B ADN 0 8
7PK2 SRC 0 2
7Q4L ADX 1 0
7QJ= BRN PLAXT
7R3W #
7RHG #
7S36 MOVE1 LDN 5 1 [1 WOERD OF INPUT
7SGQ BRN NTRFC
7T2B MOVE2 LDN 5 2
7TG2 BRN NTRFC
7T^L MOVE3 LDN 5 3
7WF= NTRFC ADN 2 1 [X2 NOW PTR TO INPUT
7WYW NTRER [ENTRY FROM SJERR ETC
7XDG BZE 5 PDCEND
7XY6 SMO 5 [X5 IS WORD COUNT
7YCQ MOVE 2 0
7YXB ADX 3 5
7^C2 SBX 7 5 [UPDATE WORDS LEFT
7^WL BRN PDCEND
82B= #
82TW # ERROR DETECTED
83*G #
83T6 SJERR LDN 5 SERR1
84#Q LDX 2 FX2
84SB STO 4 REMAINS(2) [NOT SAVED YET
85#2 LDX 0 PDCPTR(2)
85RL BCHX 0 £
86?= STO 0 PDCPTR(2) [+1 SINCE NO PDC YET !?!
86QW BRN SJRR
87=G SJERR2
87Q6 LDN 5 SERR2
889Q SJRR LDX 2 FX1
88PB SMO 5
8992 LDX 0 0(2)
89NL SBX 7 0
8=8= BPZ 7 OKSRR
8=MW SMO FX2
8?7G STO 3 OUTCHAR
8?M6 CALL 6 SETJ
8#6Q CALL 6 RESTART
8#LB CALL 6 RESETJ
8*62 OKSRR LDX 2 FX2
8*KL LDX 2 PDCPTR(2)
8B5= SLC 2 2
8BJW SBN 2 1
8C4G SRC 2 2
8CJ6 LDN 0 JPDERRMESS
8D3Q DCH 0 0(2) [OVERWRITE PDC
8DHB LDX 2 5
8F32 ADX 2 FX1
8FGL LDX 5 0(2)
8G2= NGXC 0 4
8GFW BCS NTRER [J IF X4 > 0
8G^G LDN 4 1
8HF6 SMO FX2
8HYQ STO 4 REMAINS [ELSE ENSURE TERMINATION
8JDB BRN NTRER
8JY2 TIDYP LDX 2 FX2
8KCL LDX 1 PTRJNL(2) [PTR TO JRNAL BLOCK
8KX= LDX 7 PDCPTR(2) [CHARPTR TO NEXT PDC POSN
8LBW SBN 7 JMESSAGE(1)
8LWG SLC 7 2
8MB6 DSA 7 JPACKORG(1) [NO OF PDC'S
8MTQ LDX 6 3 [NEXT PARAM POSN
8N*B SBN 3 JMESSAGE(1)
8NT2 SBX 3 SIGNW(2) [-NOOF WORDS ALLOWED FOR PDCS
8P#L ADN 7 3
8PS= SRL 7 2
8Q?W ADN 7 JMESSAGE(1) [PTR TO WORD AFTER PDC'S
8QRG SBX 6 3
8R?6 TXU 6 7
8RQQ BCC NOMVE [J IF MOVE FUTILE
8S=B BZE 3 NOMVE
8SQ2 MOVE 6 0(3) [ELSE JACK UP
8T9L NOMVE ADX 7 3
8TP= SBN 7 A1-1(1) [X7=NO OF USED WORDS
8W8W LDX 3 1
8WNG ALTLEN 3,7 [CUT EXCESS OFF
8X86 SBN 7 JMESSAGE-A1+1
8XMQ SLA 7 2 [NUMBER OF CHARS IN MESS
8Y7B MHUNTW 3,GMON,JRNAL
8YM2 #
8^6L # AT LAST TO SYSJOURN !
8^76 ...#SKI JWPHASE4
8^7L ...(
8^86 ...SJOIN GMONTIDY 3,7,PACKED [TIDY UP GMON/JRNAL
8^8L ... LDX 0 GDESTINY(2)
8^96 ... ANDN 0 #2000
8^9L ... BZE 0 SJOIN5 [J IF NOT HLS DESTINY
8^=6 ... ERS 0 GDESTINY(2) [REMOVE HLS DESTINY IND.
8^=L ... LDX 5 ALOGLEN(3)
8^?6 ... SBN 5 4
8^?L ... LDN 1 A1+3(3)
8^#6 ... LDN 2 A1(3)
8^#L ... SMO 5 [REMOVE THREE......
8^*6 ... MOVE 1 0 [WORDS OF.......
8^*L ... ALTLENG 3,5 [RED TAPE & CHECKSUM
8^B6 ... HLSINFORM RENTRY,MESSAGE,,,TEMPQBLOK [EVENT TO HLS
8^BL ... VFREEW GMON,JRNAL
8^C6 ...RENTRY
8^CL ... LDX 1 FX1
8^D6 ... LDX 0 GDESTINY(2)
8^DL ... ANDX 0 WSJPK(1)
8^F6 ... BZE 0 SJOIN1 [J IF NOT SJ&PA DESTINY
8^FL ... BRN SENTRY1 [-> PROCESS JOURNAL
8^G6 ...TEMPQBLOK
8^GL ... NAME 3,ADATA,ASUP
8^H6 ... EXIT 7 0
8^HL ...SJOIN5
8^J6 ... SJCHAINY 3
8^JL ...SJOIN1
8^K6 ...)
8^KL ...#SKI JWPHASE4<1$1
8^L= SJOIN SJCHAIN 3,7,PACKED
925W LDN 5 MKGMONACC
92KG LDN 6 MKASET
9356 ANDX 5 MARKS(2) [0 IF NO DATA BLOCK
93JQ ANDX 6 MARKS(2) [0 IF NO PARAM BLOCK
944B LDXC 0 GDESTINY(2)
94J2 ANDX 0 HALFTOP [SINCE MARKS=MDESTINY
953L BZE 0 WOOPS [J IF NO OTHER DESTINY
95H= BZE 5 NODATA
962W MHUNTW 3,ADATA,GMONACC
96GG STOZ ZDATE(3) [CLEAR FOR MONFIL
9726 NODATA
97FQ BZE 6 NPARS [J IF NO PARAMETERS
97^B ACROSS MONFIL,1 [ELSE TO MESSAGE ASSEMBLY
98F2 NPARS ACROSS MONOLITH,2
98YL # CLEAN UP PATH
99D= WOOPS MFREEW GMON,ATEMP
99XW BZE 6 OUTOK
9=CG MFREEW GMON,ASET [FREE ASET IF EXISTS
9=X6 OUTOK BZE 5 NDATA
9?BQ MFREEW ADATA,GMONACC [DITTO DATA BLOCK
9?WB NDATA UP
9#B2 #
9#TL # CF MONFIL FOR ANNOTATION
9**= #
9*SW RECIK9 +1000/K9
9B#G #
9BS6 # S/R'S FROM MONFIL
9C?Q SAVEB LDX 2 FX2
9CRB CALL 5 TDATA
9D?2 BZE 0 SAV1 [J IF NO DATA BLOCK
9DQL MHUNTW 3,ADATA,GMONACC
9F== BRN SOK1
9FPW SAV1 LDN 0 MKGMONACC
9G9G ORS 0 MARKS(2) [SET MARKER AT THIS LEVEL
9GP6 SBX 6 FX1
9H8Q SETNCORE 20,3,ADATA,GMONACC
9HNB STOZ JPROPCON(3)
9J82 STOZ ZDATE(3)
9JML ADX 6 FX1
9K7= SOK1 ADN 2 ACOMMUNE1
9KLW ADN 3 A1
9L6G MOVE 2 9
9LL6 EXIT 6 0
9M5Q #
9MKB UNSVB MHUNTW 1,ADATA,GMONACC
9N52 ADN 1 A1
9NJL LDX 2 FX2
9P4= ADN 2 ACOMMUNE1
9PHW MOVE 1 9
9Q3G EXIT 6 0
9QH6 # TEST IF DATA BLOCK (X0)
9R2Q TDATA LDN 0 MKGMONACC
9RGB SMO FX2
9S22 ANDX 0 MARKS
9SFL EXIT 5 0
9S^= #
9TDW VJOB FCJOB 2,FX2,PCA,CPA,OLPA
9TYG EXIT 6 0
9WD6 #
9WXQ #
9XCB # ROUTINES FOLLOW :-
9XX2 [NOTE THAT MOST ARE SERVICED BY 'QUICK'
9YBL #
9YW= #
9^*W QDATENOW
9^TG BRN SJERR2 [NOT OUTPACK
=2*6 LDN 4 0
=2SQ BRN QDATIM
=3#B #
=3S2 #
=4?L #
=4R= QTIMENOW
=5=W BRN SJERR2
=5QG LDN 4 1
=6=6 QDATIM CALL 5 TDATA
=6PQ BZE 0 VIRST [J IF FIRST PASS
=79B MHUNTW 2,ADATA,GMONACC
=7P2 LDX 0 ZDATE(2)
=88L BZE 0 VIRST [DO.
=8N= SMO 4
=97W LDX 6 ZDATE(2) [DATE/TIME
=9MG STO 6 0(3)
==76 BRN TIMED
==LQ #
=?6B # AS IN MONFIL,THE DAE AND TIME ARE LODED TOGETHER
=?L2 #
=#5L VIRST CALL 6 SETJ
=#K= CALL 6 SAVEB
=*4W ADN 3 ZDATE-A1
=*JG BNZ 4 VDAT1
=B46 VTIM1 LDX 6 CLEANCT
=BHQ SMO FX1
=C3B DVS 5 RECIK9
=CH2 STO 6 1(3)
=D2L BNZ 4 VEND [OUTIF 2ND PASS
=DG= VDAT1 LDX 6 EDATE
=D^W STO 6 0(3)
=FFG BNZ 4 VTIM1 [DITTO
=F^6 VEND SBN 3 ZDATE-A1-OUTCHAR+ACOMMUNE1
=GDQ LDX 3 0(3) [OUTPUT PTR
=GYB MHUNTW 1,GMON,JRNAL
=HD2 ADX 3 1
=HXL STO 6 0(3)
=JC= CALL 6 UNSVB
=JWW CALL 6 RESETJ
=KBG TIMED ADN 3 1
=KW6 SBN 7 1
=L*Q BRN PDCEND
=LTB #
=M*2 #
=MSL QTIMETHEN
=N#= LDX 6 1(2)
=NRW SMO FX1
=P?G DVS 5 RECIK9 [->SECONDS
=PR6 STO 6 0(3)
=Q=Q BRN TIMED
=QQB #
=R=2 #
=RPL QUSERNAME
=S9= BRN QUICK [IF OUTPACK
=SNW CALL 6 VJOB
=T8G ADN 2 JUSER-1
=TN6 BRN MOVE3
=W7Q #
=WMB #
=X72 QJOBNAME
=XLL BRN QUICK
=Y6= CALL 6 VJOB
=YKW ADN 2 JNAME-1
=^5G BRN MOVE3
=^K6 #
?24Q #
?2JB QPROGCORE
?342 BRN QUICK
?3HL CALL 6 VJOB
?43= ADN 2 JCSIZE-1
?4GW BRN MOVE1
?52G #
?5G6 #
?5^Q N10 +10
?6FB QPROGMILL
?6^2 BRN MILL
?7DL CALL 6 VJOB
?7Y= ADN 2 HCLOCKTIME-1
?8CW BRN MILL
?8XG #
?9C6 #
?9LY ...QGEOMILL
?9WQ QJOBMILL
?=BB BRN MILL
?=W2 CALL 6 VJOB
??*L ADN 2 HTIMJ-1
??T= MILL LDX 4 1(2)
?##W LDX 5 2(2)
?#SG SMO FX1
?*#6 DVD 4 N10 [1/100 THS SECS
?*RQ STO 5 0(3)
?B?B SBN 7 1
?BR2 BUX 3 PDCEND
?C=L #
?CQ= #
?D9W QERRMESS
?DPG QVARCHAR
?F96 QENTRANT
?FNQ QVARDEC
?G8B QVAROCT
?GN2 LDX 5 0(2)
?H7L SRL 5 6
?HM= ANDN 5 4095
?J6W ADN 5 1 [WORDS+1=RECHDDR
?JLG STO 5 0(3)
?K66 SBN 5 1
?KKQ SBN 7 1
?L5B BUX 3 NTRFC
?LK2 #
?M4L #
?MJ= QPROPS [CF MONFIL
?N3W CALL 5 TDATA
?NHG BZE 0 PROPCON [J IF NO DATA BLOCK
?P36 MHUNTW 1,ADATA,GMONACC
?PGQ LDX 0 JPROPCON(1)
?Q2B BZE 0 PROPCON
?QG2 ADN 2 A1
?Q^L SMO FX2
?RF= SBX 2 PTRASET [X2 IS A KEY
?RYW PR1 TXU 2 JPROPCON+1(1)
?SDG BCC THIS
?SY6 LDX 6 JPROPCON+2(1)
?TCQ ADN 6 11
?TXB SRL 6 2
?WC2 ADX 1 6
?WWL BRN PR1
?XB= #
?XTW PROPCON
?Y*G LDX 0 0(2)
?YT6 SRL 0 6
?^#Q ANDN 0 4095
?^SB SBN 0 1
#2#2 ADX 0 1(2) [ZERO IFF JUST CENTRAL
#2RL BNZ 0 VPROP
#3?= SMO FX1
#3QW LDN 1 XCENT-2-JPROPCON
#4=G THIS LDN 2 JPROPCON+2(1) [->PROPERTY STRING
#4Q6 LDX 5 0(2) [CHARACTER CNT
#59Q ADN 5 7
#5PB SRL 5 2
#692 STO 5 0(3) [RECORD HDDR
#6NL SBN 7 1
#78= SBN 5 1
#7MW BUX 3 NTRFC [INPUT STRING
#87G XCENT +7,8HCENTRAL
#8M6 VPROP CALL 6 SETJ
#96Q CALL 6 SAVEB
#9LB MPROPCON
#=62 CALL 6 UNSVB
#=KL CALL 6 RESETJ
#?5= BRN QPROPS [TRY AGAIN
#?JW #
##4G #
##J6 QSKIP
#*3Q QNULL
#*HB NULL [FOR 'OUTPACK'
#B32 LDX 2 FX2
#BGL LDX 2 PDCPTR(2)
#C2= SLC 2 2
#CFW SBN 2 1
#C^G SRC 2 2
#DF6 SMO FX2
#DYQ STO 2 PDCPTR [BQCSPACE
#FDB LDN 0 0
#FY2 DCH 0 0(2) [+ CLEAR PDC
#GCL BRN PLAXT
#GX= #
#HBW #
#HWG QGEOPER
#JB6 BRN QUICK
#JTQ LDX 2 FX2
#K*B GEOPACK 5
#KT2 WORD1 [INSERT X5
#L#L STO 5 0(3)
#LS= SBN 7 1
#M?W BUX 3 PDCEND
#MRG #
#N?6 #
#NQQ QURGENCY
#P=B LDCH 5 1(2) [GET URGENCY LETTER
#PQ2 BRN WORD1
#Q9L #
#QP= #
#R8W #OPT QLOCNAME=QUICK
#RNG #OPT QGENNUM=QUICK
#S86 #OPT QLANGUAGE=QUICK
#SMQ #OPT QJOBTYPE=QUICK
#T7B #OPT QPROGNAME=QUICK
#TM2 #OPT QURGENCY=QUICK
#W6L #OPT QPERITYPE=QUICK
#WL= #OPT QPERINAME=QUICK
#X5W #OPT QTSNCSN=QUICK
#XKG #OPT QTRANSCT=QUICK
#Y56 #OPT QBUDGTYPE=QUICK
#YJQ #OPT QBUDGQUAN=QUICK
#^4B #OPT QINCNUM=QUICK
#^J2 #OPT QBLOCKCT=QUICK
*23L #OPT QFAILCT=QUICK
*2H= #OPT QREPEATS=QUICK
*32W #OPT QNUMA=QUICK
*3GG #OPT QNUMB=QUICK
*426 #OPT QNUMC=QUICK
*4FQ #OPT QNUMD=QUICK
*4^B #OPT QOCTA=QUICK
*5F2 #OPT QOCTB=QUICK
*5YL #OPT QDATETHEN=QUICK
*6D= #OPT QPAGETURN=QUICK
*6XW #OPT QQUOTA=QUICK
*7CG #OPT QSWITCH=QUICK
*7X6 #OPT QREELNUM=QUICK
*8BQ MENDAREA 50,GAPMONJRNAL
*8WB #END
^^^^ ...13513757000300000000