(George Source)
Macros used: ACROSS, ALTLEN, ALTLENG, BSON, CATMASK, FCJOB, GEOPACK, GMONTIDY, HLSINFORM, MENDAREA, MFPDCTAB, MFREEW, MHUNTW, MILL, MPROPCON, NAME, NEXTPART, OVER, RESTART, SEGENTRY, SETNCORE, SETUPCORE, SJCHAIN, SJCHAINY, UP, 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