MONFIL865
(George Source)
Macros used: ACROSS, ALTLEN, BXL, CATMASK, ERROR, FCJOB, FREECORE, GEOPACK, MENDAREA, MFPDCTAB, MFREEW, MFSAVE, MFUNSAVE, MHUNTW, NEXTPART, OUTNUM, RESET, RESTART, SEGENTRY, SETNCORE, SETUPCORE, TIMECON2
- MONFIL865.txt
22FL #SEG MONFIL70 [RJD GRIMWADE 22S3 ...#OPT K0MONFIL=0 236D ...#LIS K0MONFIL>K0MONCHAPS>K0ALLGEO>K0GREATGEO 23DW 8HMONFIL 23YG SEGENTRY K1MONFIL,SENTRY1 24D6 SEGENTRY K2MONFIL,SENTRY2 24XQ # THIS SEGMENT COMPILES A MESSAGE FROM THE 25CB # INGREDIENTS HELD IN AN ATEMP AND POSSIBLY 25X2 # AN ASET(PARAMETER) BLOCK INTO A BOUT BLOCK 26BL # 375G MFPDCTAB [EXPAND ! 37K6 # S/R TO FIND THE SPECIFIED PARAMETER 384Q # X1->ATEMP CHAR POSN 38JB # X3->AOUT CHAR POSN 3942 # EXIT+0 IF ERROR DETECTED 39HL # ON EXIT X2->FIRST WORD OF PARAM /<0 IF NOSUCH 3=3= # X1+3 UPDATED 3=GW # V SET IF PDC'S ARE 'SPECIAL' 3?2G # X4 PRESUMED COUNT OF CHARS LEFT IN ATEMP 3?G6 # WHATJUST IS JUSTIFICATION INDIC. ON EXIT 3?^Q # 3#FB PARAM BCHX 1 £ 3#^2 SBN 4 1 3*DL LDCH 5 0(1) 3*Y= SBN 5 #41 3BCW BPZ 5 NOJUS [J IF FF CHAR A LETTER 3BXG ADN 5 #41 3CC6 ORX 6 5 [FIELD LENGTH 3CWQ BCHX 1 £ [NEXT CHAR SHLD BE LETTER 3DBB SBN 4 1 3DW2 PARM1 LDCH 5 0(1) 3F*L SBNC 5 #41 3FT= BCS PERR [ERROR IF NOT 3G#W NOJUS LDX 2 FX2 3GSG STO 6 WHATJUST(2) 3H#6 LDX 2 PTRASET(2) [-> A1 OF ASET 3HRQ TXL 5 0(2) 3J?B BCS PEXST 3JR2 NGN 2 4095 [HERE IF NO SUCH PARAM 3K=L BRN PEND 3KQ= PEXST BZE 5 PFND [J IF'A' 3L9W PLOOP LDXC 6 2(2) 3LPG BCC PAR1 [J IF ORDINARY PARAM 3M96 SLL 6 1 3MNQ BPZ 6 PAR2 [J IF NOT OUTNUM'D 3N8B BDX 2 PNEXT 3NN2 PAR2 SRL 6 7 [WORD CT IN B6-17 3P7L ANDN 6 4095 3PM= BUX 6 PAR3 [+1 FOR 1ST WORD 3Q6W PAR1 ADN 6 7 3QLG SRL 6 2 3R66 PAR3 ADX 2 6 [ADD TOTAL LENGTH (WORDS) 3RKQ PNEXT BCT 5 PLOOP 3S5B PFND ADN 2 2 [X2->1ST WORD OF PARAM 3SK2 SMO FX2 3T4L LDX 6 PARTPTR 3TJ= LDCT 5 #40 3W3W SMO 6 3WHG ANDX 5 1 [TEST PACK BIT 3X36 BZE 5 PEND [J IF NOT PACKED 3XGQ BCHX 1 £ 3Y2B SBN 4 1 3YG2 LDCH 5 0(1) 3Y^L ERX 5 0(2) 3^F= ANDN 5 #77 3^YW BZE 5 PEND [J IF PDC'S TALLY 42DG LDCH 5 0(1) 42Y6 PTEST BZE 5 PENDA [J IF NOTJOURN 43CQ SBN 5 JPDNULL 43XB BZE 5 PENDA [OR NULL 44C2 ADN 5 JPDNULL-JPDSKIP 44WL BZE 5 PENDA [OR SKIP 45B= LDX 5 0(2) 45TW BZE 5 PEND [J IF 'OUTNULL' 46*G ANDN 5 #77 [ASET PDC 46T6 BVCI PTEST 47SB PENDA BVS PEND 48#2 BVCI £ [ENSURE V SET 48RL PEND 49?= BNG 4 PERR [J IF OVERSPILL 49QW BZE 4 PERR [OR IF COUNTED OUT 49Y4 ... ADN 0 1 4=5= ...PERR 4==G PEX SMO FX2 4=Q6 STO 4 REMAINS 4?9Q ... BRN (0) 4#NL SERR1 +18 4*8= 20HPDC'S DON'T TALLY! 4*MW SERR2 +20 4B7G 20HPARAM NOT OUTPARABLE 4BM6 SERR3 +19 4C6Q 20H!!ASSEMBLY ERROR !! 4CLB # 4D62 # S/R TO CONVERT S/L X5->ACOMMUNE5+6 (SIG-FIGS ONLY) 4DKL # X5 WILL LATER CONTAIN NO OF SIG-FIGS 4F5= # ACOMMUNE4 O/W V SHOULD BE SET O/S IF Z-SUPP 4FJW # 4G4G OCTALV ORX 0 GSIGN [ENSURE ZERO-SUPPRESSION 4GJ6 OCTAL LDX 1 FX2 4H3Q LDN 4 #23 [# 4HHB STO 4 SIGNW(1) [INTERFACE 4J32 LDN 6 8 4JGL BPZ 0 ONAGN [J IF NZ SUPP (V CLEAR) 4K2= BZE 5 OCTEX [J IF ZERO TO CONVERT-NOSIGS 4KFW LDN 4 0 4K^G OLOOP SLL 45 3 4LF6 BNZ 4 OHNZ 4LYQ BCT 6 OLOOP 4MDB ONAGN LDN 4 0 4MY2 SLL 45 3 4NCL OHNZ DCH 4 WORK8(1) 4NX= BCHX 1 £ 4PBW BCT 6 ONAGN 4PWG OCTEN SBX 1 FX2 4QB6 SLC 1 2 4QTQ LDX 5 1 4R*B BRN (0) [CLEAR V 4RT2 # 4S#L # SIMILARLY FOR DECIMAL-X4=NUMBER 4SS= # 4T?W MAGIC +7036875 4TRG MINUS0 8H8388608 [#40000000 4TYN ...#SKI JWPHASE4 4W5W ...X2048 +2048 4W?6 TENSV ORX 0 GSIGN [ENSURE ZERO-SUPPRESSION 4WQQ TENS LDX 1 FX2 4X=B LDN 5 0 4XQ2 BZE 4 TENEX [OUT IF ZERO 4Y9L BPZ 4 TPOS 4YP= NGX 4 4 4^8W LDN 5 #35 [- 4^NG BPZ 4 TPOS 5286 STO 5 SIGNW(1) [HERE IF #40000000 52MQ SMO FX1 537B LDN 4 MINUS0 53M2 LDN 5 WORK8(1) 546L MVCH 4 7 54L= LDN 5 7 555W BRN (0) 55KG TPOS STO 5 SIGNW(1) [SIGN OR 0 5656 SMO FX1 56JQ MPY 4 MAGIC 574B LDN 6 7 57J2 BPZ 0 TNAGN 583L LDN 1 0 58H= TLOOP CBD 4 1(1) [CHUCK 0'S OFF INTO TOP OF X1 592W BNZ 1 TNZER 59GG BCT 6 TLOOP 5=26 TNZER SMO FX2 5=FQ STO 1 WORK8 5=^B LDX 1 FX2 5?F2 BRN TNAGO 5?YL TNAGN CBD 4 WORK8(1) 5#D= TNAGO BCHX 1 £ 5#XW BCT 6 TNAGN 5*CG BRN OCTEN 5*X6 OCTEX LDN 5 8 5BBQ NUMEX STOZ WORK8(1) 5BWB STOZ WORK8+1(1) 5CB2 BPZ 0 (0) [IF NOT Z-SUPP 5CTL LDN 5 1 5D*= BRN (0) 5DSW TENEX LDN 5 7 5F#G STOZ SIGNW(1) [SET + 5FS6 BRN NUMEX 5G?Q # 5GRB # S/R TO SET X4=REMAINS, X2=FX2 5H?2 # X1->NEXT INPUT CHAR POSN 5HQL # 5J== SET124 5JPW LDX 2 FX2 5K9G LDX 1 PARTPTR(2) 5KP6 LDEX 4 0(1) [CHARS THID PART 5L8Q ADN 4 8 5LNB SBX 4 REMAINS(2) 5M82 SRC 4 2 5MML ADX 1 4 [X1 SET TO NEXT INPUT 5N7= LDX 4 REMAINS(2) 5NLW EXIT 0 0 5P6G # 5PL6 # SPECIAL S/R TO GET LENGTH OF CONV'D PDC IN X0 5Q5Q # X3 HOLDS PDC, X2->PARAMETER 5QKB # EXIT +0 IF NOT TABLED, ELSE X5=COPY OF ENTRY 5R52 # 5RJL PDCLEN 5S4= ANDN 3 #77 5SHW SMO FX1 5T3G LDX 3 PDCTAB(3) 5TH6 BZE 3 (6) [OUT IF NIT IN TABLE 5W2Q LDX 5 3 [ELSE KEEP COPY 5WGB LDX 0 3 5X22 SLC 0 9 5XFL ANDN 0 #177 [MAX LENGTH 5X^= SLL 3 1 5YDW BNG 3 VARPDC [J IF VARIABLE 5YYG EXIT 6 1 5^D6 VARPDC LDX 3 0(2) 5^XQ SRL 3 6 62CB ANDN 3 511 [TOTAL NUMBER 62X2 MPY 3 0 63BL LDX 0 4 63W= EXIT 6 1 64*W # 64TG # RESTARTS: X7 IS ALWAYS A COUNT OF CHARACTERS LEFT 65*6 # THIS S/R SHOULD BE CALLED WE THIS EXPIRES. 65SQ # IT IS ASSUMED THAT CERTAIN WELL DEFINED WORK WORDS 66#B # HAVE BEEN PRIORLY UPDATED - IT OUGHT TO BE POSS. 66S2 # TO RESTART AS IF NOTHING HAD HAPPENED ON EXIT 67?L # 67R= SET 68=W LDX 1 FX2 68QG STO 2 X2(1) 69=6 MHUNTW 2,GMON,ATEMP 69PQ MHUNTW 3,GMON,BOUT 6=9B SBS 2 PARTPTR(1) [RELATIVIZE MESSAGE PART PTR 6=P2 LDX 2 PTRASET(1) 6?8L SBS 2 X2(1) 6?N= SBS 3 OUTCHAR(1) [AND OUTPUT CHAR 6#7W SBS 3 THISPART(1) 6#MG SBS 3 SAFE(1) 6*76 EXIT 6 0 6*LQ # 6B6B # NOW RE-RELATIVIZE 6BL2 # 6C5L RESET MHUNTW 1,GMON,ATEMP 6CK= MHUNTW 3,GMON,BOUT 6D4W LDX 2 FX2 6DJG ADS 3 THISPART(2) 6F46 ADS 3 OUTCHAR(2) 6FHQ ADS 3 SAFE(2) 6G3B MHUNTW 3,GMON,ASET 6GH2 ADN 3 A1 6H2L ADS 3 X2(2) 6HG= STO 3 PTRASET(2) 6H^W ADS 1 PARTPTR(2) 6JFG CALL 0 SET124 6J^6 LDX 3 OUTCHAR(2) 6KDQ LDX 2 X2(2) 6KYB EXIT 6 0 6LD2 RESTART [X3->OUTPUT BLOCK 6LXL SBX 6 FX1 6MC= LDX 4 ALOGLEN(3) 6MWW ADN 4 MORE 6NBG ALTLEN 3,4 6NW6 ADN 7 MORE*4 6P*Q ADX 6 FX1 6PTB EXIT 6 0 6QSL # 6R#= # DELAYED CONVERSION ROUTINES - OUTPUT TO (3) 6RRW # 6S?G OUTNUM 6SR6 BVCR £ [ENSURE V CLEAR 6T2Y ... NGNC 4 1 [X4=#37777777 6T=Q LDCT 0 #40 6TQB ANDX 0 0(2) 6W=2 LDCT 5 #620 6WPL ERX 5 0(2) 6X9= ... BZE 5 OKNUM 6XNW ... ADN 0 1 6Y8G ...OKNUM ADX 0 4 [SET V IF ZERO SUPPRESSION 6^7Q LDCT 0 #100 6^MB ANDX 0 0(2) 7272 BZE 0 ODECI [J IF DECIMAL 72LL LDX 5 1(2) 736= CALL 0 OCTAL 73KW BRN OJOIN 745G ODECI LDX 4 1(2) 74K6 CALL 0 TENS 754Q OJOIN LDN 0 0 75JB SMO FX2 7642 TXU 0 SIGNW 76HL SBN 7 0 [-1 FOR SIGN IF NEC 773= LDEX 6 0(2) 77GW LDX 0 5 782G TXL 0 6 78G6 BCC WIDTH 78^Q LDX 0 6 [TAKE MAX(WIDTH,NO OF SIGS) 79FB WIDTH SBX 7 0 79^2 BPZ 7 OROOM 7=DL CALL 6 SET 7=Y= CALL 6 RESTART 7?CW CALL 6 RESET 7?XG LDEX 6 0(2) 7#C6 OROOM LDCT 0 #40 7#WQ ANDX 0 0(2) 7*BB LDCT 1 #20 7*W2 ANDX 1 0(2) 7B*L LDX 2 FX2 7BT= LDN 4 0 7C#W TXU 4 SIGNW(2) 7CSG ADN 5 0 [ADD 1 IF A SIGN 7D#6 BZE 6 ONUM2 [J IF ZERO FIELD SIZE 7DRQ TXL 6 5 7F?B BCC ONUM3 [J IF F-SIZE>=WIDTH 7FR2 BNZ 0 ONUM2 [J IF ZERO-SUPPRESSION 7G=L SBX 5 6 7GQ= SLL 2 2 7H9W ADX 2 5 [IGNORE TOP 'ZEROES' TO MAKE FIT 7HPG SRC 2 2 7J96 LDX 5 6 [WIDTH:=FIELD SIZE 7JNQ BRN ONUM1 7K8B ONUM2 LDX 6 5 [FIELDSIZE:=WIDTH 7KN2 BRN ONUM1 7L7L ONUM3 LDN 0 #20 7LM= LDX 2 3 7M6W LDX 4 6 7MLG SPFIL DCH 0 0(2) [SPACEFILL FIELD 7N66 BCHX 2 £ 7NKQ BCT 4 SPFIL 7P5B LDX 2 FX2 7PK2 ONUM1 BNZ 1 ONUM4 [J IF R-JUSTIFIED 7Q4L SBX 6 5 [OVERSPILL 7QJ= BZE 6 ONUM4 7R3W SLC 3 2 7RHG ADX 3 6 [STEP ON PTR 7S36 SRC 3 2 7SGQ ONUM4 SMO FX2 7T2B LDX 4 SIGNW 7TG2 BZE 4 ONUM5 [JIF NO SIGN 7T^L DCH 4 0(3) [ELSE INSERT 7WF= BCHX 3 £ 7WYW SBN 5 1 [AND ADJUST WIDTH 7XDG ONUM5 ADN 2 WORK8 7XY6 SMO 5 7YCQ MVCH 2 0 [MOVE FIGS IN 7YXB BRN PDCEND 7^C2 # 7^WL PAKJR CATMASK JL,PACKED 82B= # 82TW # 83*G SENTRY1 [ENTRY FROM MONFILE 83K# ... CALL 6 SAVEB [SET UP BLOCK WITH DATE &TIME 83T6 # HERE WHEN ANY PACKED O/P HAS GONE 84#Q # 84SB # 85#2 # 85RL # PARAMETERS TO SUBSTITUTE: 86?= # 86QW # FIRST, TRY TO SAVE GETCORE'S BY GETTING A BLOCK SUFFICIENTLY 87=G # LARGE : 87Q6 # SEARCH ASET FOR DELAYED PARAMS ETC: 889Q # 88PB SFINE LDN 7 3 [TO BE CHAR COUNT 8992 MHUNTW 2,GMON,ASET 89NL LDX 1 A1(2) [NO OF PARAMS 8=8= ADN 2 A1+2 [PTR TO FIRST 8=MW QUOTA LDX 0 0(2) 8?7G BNG 0 QUOTB [J IF DELAYED 8?C# ... ANDN 0 #7777 8?M6 ADX 7 0 8#6Q ADN 0 7 8#LB SRL 0 2 8*62 ADX 2 0 [TO NEXT 8*KL BRN QUNXT 8B5= QUOTB SLL 0 1 8BJW BPZ 0 QUOTD [J IF NOT OUTNUM 8C4G ADN 7 9 [MAX IS #00000000 8CJ6 BDX 2 QUNXT 8D3Q QUOTD LDX 3 0(2) 8DHB CALL 6 PDCLEN [GET LENGTH 8F32 LDN 0 30 [IF ERROR +30 FOR MESSAGE 8FGL ADX 7 0 8G2= QUOTE LDX 0 0(2) 8GFW SRL 0 6 8G^G ANDN 0 4095 [WORD LENGTH 8HF6 ADX 2 0 8HYQ ADN 2 1 8JDB QUNXT BCT 1 QUOTA 8JY2 SRL 7 2 [MAX WORDS 8KCL MHUNTW 2,GMON,ATEMP 8KX= ADX 7 ALOGLEN(2) [CHANGE FOR JUSTIFICATION? 8LBW # X7 SHOULD BE LONG ENOUGH 8LWG SETUPCORE 7,3,GMON,BOUT 8MB6 SLA 7 2 [NO OF CHARS AVAILABLE 8MTQ MHUNTW 1,GMON,ASET 8N*B ADN 1 A1 8NT2 STO 1 PTRASET(2) 8P#L MHUNTW 1,GMON,ATEMP 8PS= ADN 1 A1 8Q?W STO 1 PARTPTR(2) [1ST PART 8QRG ADN 3 A1 8R?6 STO 3 THISPART(2) [O/P PART ! 8RQQ # 8S=B # WE NOW CREATE THE OUTPUT MESSAGE 8SQ2 # ALL PARTS ARE IN THE ONE BOUT 8T9L # BLOCK 8TP= # 8W8W BRN NOPKD 8WNG SERTB LDX 2 FX2 8X86 LDCT 0 #100 8XMQ ANDX 0 1(1) 8Y7B BZE 0 OFFWG [OUT IF NOT CONTINUED 8YM2 NEXTPART 1 8^6L NOPKD LDEX 4 0(1) [CHAR-COUNT 8^L= SBN 7 8 925W BPZ 7 RREUM [J IF ROOM FOR R-HDDR 92KG LDX 2 FX2 9356 STO 4 REMAINS(2) 93JQ STO 3 OUTCHAR(2) 944B CALL 6 SET 94J2 CALL 6 RESTART 953L CALL 6 RESET 95H= ...RREUM LDX 2 3 962W ... MOVE 1 2 97FQ LDX 2 FX2 97^B STO 3 THISPART(2) 98F2 ADN 1 2 98YL ADN 3 2 998D ... BZE 4 SERTD [J IF NULL SKELETON 99D= SERTI BNZ 7 SERTN [J IF ROOM NEXT CHAR 99XW STO 3 OUTCHAR(2) 9=CG STO 4 REMAINS(2) 9=X6 CALL 6 SET 9?BQ CALL 6 RESTART 9?WB CALL 6 RESET 9#B2 SERTN LDCH 0 0(1) 9#TL SBN 0 #25 9**= BZE 0 SERTC [J IF % 9*SW SBN 0 #74-#25 9B#G BZE 0 SERRJ [J IF $ 9BS6 ADN 0 #74 9C?Q DCH 0 0(3) [ELSE INSERT 9CRB BCHX 3 £ 9D38 SBN 7 1 9D?2 SERTE BCHX 1 £ 9DQL BCT 4 SERTI 9F== # THIS-PART OVER 9FPW SERTD LDX 2 FX2 9G9G LDX 1 3 9GP6 SBX 1 THISPART(2) 9H8Q SBN 1 2 [- 2 WORD HEADER 9HNB SLC 1 2 9HPM ...#SKI JWPHASE4 9HQY ...( 9HS9 ... SMO FX1 9HTG ... BXL 1 X2048,SHORTENUF 9HWR ... SLC 3 2 9HY4 ... SBX 3 1 9H^* ... ADN 3 #3777 9J2L ... SRC 3 2 9J3X ... LDN 1 #3777 9J58 ...SHORTENUF 9J6F ...) 9J82 SMO THISPART(2) 9JML DSA 1 0 [INSERT CHAR COUNT 9JSR ... LDN 0 #4000 9JWG ... SMO PARTPTR(2) 9JY9 ... ANDX 0 0 9J^Y ... SMO THISPART(2) 9K3M ... ORS 0 0 9K7= ANDN 1 3 9KLW BZE 1 XX0 9L6G SBN 1 4 9LL6 ADX 7 1 [ROUND TO WHOLE WORD 9M5Q LDN 2 ACES 9MKB NGX 1 1 9N52 MVCH 2 0(1) [SPACEFILL (GSCAN) 9NJL LDX 2 FX2 9P4= XX0 9PHW LDX 1 PARTPTR(2) 9Q3G BRN SERTB 9QH6 # 9S22 # 9SFL # PARAMETER SUBSTITUTION 9S^= # 9TDW SERRJ LDCT 0 #400 [ENTRY FOR $ 9TYG SERTC LDX 6 0 9WD6 CALL 0 PARAM 9WXQ BRN PARER1 [ERROR MESSAGE 9XCB BNG 2 SERTD [J IF NO SUCH TO END 9XX2 BVC NTER1 [J IF NOT SPECIAL 9YBL LDCH 5 0(1) 9YW= BNZ 5 PDELAY [J IF NOT NOTJOURN 9^*W BVCR £ 9^TG NTER1 =2*6 LDXC 0 0(2) =2SQ BCS PDELAY [J IF DELAYED CONV =34J ... ANDN 0 #7777 =3#B CALL 6 TJUST [UPDATE X0 FOR JUST. =3S2 SBX 0 7 =4?L BNG 0 OKAY [J IF NUFF ROOM =4R= SMO FX2 =5=W STO 3 OUTCHAR =5QG SMO FX2 =6=6 STO 2 X2 =6PQ CALL 6 SET =79B CALL 6 RESTART =7P2 CALL 6 RESET =88L OKAY CALL 6 USTADJ [AD'JUST' IF NEC =8N= LDX 0 0(2) =97W ADN 2 1 =9MG BZE 0 NULL =9X# ... SBX 7 0 ==76 MV2 SBN 0 513 ==LQ BNG 0 MV1 [J IF < 513 CHARS TO MOVE =?6B MVCH 2 0 =?L2 BUX 0 MV2 =#5L MV1 SMO 0 =#K= MVCH 2 1 =*JG NULL =B46 LDX 2 FX2 =BHQ BRN YJUST =C3B # =CH2 # DELAYED CONVERSION =D2L # WE CHECK THAT THERE IS ENOUGH ROOM FOR =DG= # THE MAX SIZE (FROM PDCTABLE) BUT LEAVE =D^W # THE UPDATING OF THE COUNT TO THE PDC =FFG # ROUTINE =F^6 PDELAY =GDQ LDX 1 FX2 =GYB STO 3 OUTCHAR(1) =HD2 BVCR UNSPEC [J IF UNSPECIAL =HXL LDCT 5 #400 =JC= ORN 5 QNULL [INTERFACE =JWW LDN 0 0 =KBG BRN TESTD =KW6 UNSPEC =L*Q SLL 0 1 =LTB BPZ 0 PDCLA [J IF NOT OUTNUM =M*2 SRL 0 1 =MSL ANDN 0 4095 =N#= ... TXL 0 JTEN =P?G BCC PMORE =PR6 LDN 0 9 [AT MOST 9 IF NO FOIELD =Q=Q PMORE LDN 5 OUTNUM [INTERFACE =QQB BRN TESTD =R=2 PDCLA LDX 3 0(2) =RPL CALL 6 PDCLEN =S9= BRN PARER2 [ERROR IF NOT IN TABLE =SNW TESTD LDX 3 OUTCHAR(1) =T8G CALL 6 TJUST [UPDATE X0 =TN6 SBX 0 7 =W7Q BNG 0 PRESS [PREESS ON IF ROOM =WMB CALL 6 SET =X72 CALL 6 RESTART =XLL CALL 6 RESET =Y6= PRESS CALL 6 USTADJ =YKW LDCT 0 #500 =^5G ERX 0 0(2) =^K6 SLC 0 3 ?24Q ANDN 0 3 ?2JB BNZ 0 NOUTP [J IF NOT OUTPAR ?342 BPZ 5 PARER3 [J IF NOT OUTPARABLE ?3HL ADN 5 1 [RESET FOR OUTPAR ENTRY ?43= NOUTP ANDN 5 4095 ?4GW ADX 5 FX1 ?52G EXIT 5 0 [OFF TO ROTINE ?5G6 # ?5^Q # X2->PARAM GDDR ?6FB # ?6^2 # TGE FF ROUTINES IMPLEMENT BELAYED CONVERSION ?7DL # PDC '%A' IS DONE BY 'Q%A' COF PDCTAB ?7Y= # ON ENTRY X3 -> THE NEXT OUTPUTCHAR AND ?8CW # SHOULD BE SO ON EXIT ?8XG # X2->PARAMETER IN ASET BLOCK ?9C6 # USE 'MFSAVE' & 'MFUNSAVE' IF COOR ?9WQ # BEWARE X6 AND SAVE X7 ?=BB # ROUTINES WHICH UPDATE X7 SHOULD REENTER AT ?=W2 # 'PDCEND' ELSE USE 'RETURN' ??*L # OUTPARABLE PDC R'S ENTERED +1 IF OUTPAR ELSE AT +0 ??T= # ?##W # IF R-JUST, X0:=X0+FIELD SIZE ?#SG # IF L-JUST, X0:=MAX(X0,FIELD-SIZE) ?*#6 # ?*RQ TJUST SMO FX2 ?B?B LDXC 4 WHATJUST ?BR2 BCS TLEF [J IF LEFT-JUST ?C=L ADX 0 4 ?CQ= TLEF BZE 4 (6) ?D9W TXL 0 4 ?DPG BCC (6) ?F96 LDX 0 4 [TAKE MAX ?FNQ EXIT 6 0 ?G8B # ?GN2 # SPACEFILL FIELD AND ADJUST X3 IF R-JUST ?H7L # ?HM= USTADJ SMO FX2 ?J6W LDX 4 WHATJUST ?JLG SMO FX2 ?K66 STO 2 X2 ?KKQ LDXC 0 4 ?L5B BZE 0 USTEX [OUT IF NONE ?LK2 LDN 0 #20 ?M4L LDX 2 3 ?MJ= SFIL DCH 0 0(2) ?N3W BCHX 2 £ ?NHG BCT 4 SFIL ?P36 BNG 4 USTEX [OUT IR LEFT-JUST ?PGQ LDX 3 2 ?Q2B USTEX LDX 2 FX2 ?QG2 STO 3 OUTCHAR(2) ?Q^L STO 3 SAFE(2) [FOR 'YJUST' & 'RETURN' ?RF= LDX 2 X2(2) ?RYW EXIT 6 0 #2#2 # S/R TO SAVE ACOMMUNE WORDS #2RL SAVEB CALL 1 SDATA [X2->DATA BLOCK #3?= BRN SAV1 [OFF IF NO SUCH #3QW LDX 3 2 #4=G LDX 2 FX2 #4Q6 BRN SOK1 #59Q SAV1 LDN 0 MKGMONACC #5PB ORS 0 MARKS(2) [SET DATA MARKER #692 SBX 6 FX1 #6NL SETNCORE 20,3,ADATA,GMONACC #78= STOZ JPROPCON(3) #7MW STOZ ZDATE(3) #87G ADX 6 FX1 #8M6 SOK1 ADN 2 ACOMMUNE1 #96Q ADN 3 A1 #9LB MOVE 2 9 #9N# ... LDX 0 ZDATE-A1(3) #9Q= ... BNZ 0 (6) [J IF ALREADY THERE #9S8 ... ADN 3 ZDATE-A1 #9W6 ... LDN 2 FDATE #9Y4 ... MOVE 2 2 #=22 ... ADN 3 2 #=3Y ... TIMECON2 3 [NOW DATE &TIME IN GMONACC #=62 EXIT 6 0 #=KL # AND TO UNSAVE #?5= UNSVB MHUNTW 1,ADATA,GMONACC #?JW ADN 1 A1 ##4G LDX 2 FX2 ##J6 ADN 2 ACOMMUNE1 #*3Q MOVE 1 9 #*HB EXIT 6 0 #B32 # EXIT +0 IF NO ADATA/GMONACC THIS LEVEL #BGL # AND X2 = FX2 #C2= # ELSE +1 WITH X2->SAME #CFW SDATA LDN 0 MKGMONACC #C^G LDX 2 FX2 #DF6 ANDX 0 MARKS(2) #DYQ BZE 0 (1) [+0 IF MARKER CLEAR #FDB MHUNTW 2,ADATA,GMONACC #FY2 EXIT 1 1 #GCL # #GX= # #HBW QTIMENOW #HWG BRN PARER1 [NOT OUTPACK #JB6 LDN 4 2 [SWITCH #JTQ BRN QDATIM #K*B # #KT2 QDATENOW #L#L BRN PARER1 #LS= LDN 4 0 #M?W QDATIM CALL 1 SDATA [HUNT DATA BLOCK #MRG ... BRN (GEOERR) #P=B SMO 4 #PQ2 ADN 2 ZDATE [PTR TO DATE/TIME #Q9L MVCH 2 8 #QP= ... SBN 7 8 *7X6 BRN PDCEND *8BQ N1000 +1000 *8WB N60000 +60000 *9B2 ...QGEOMILL [GEOMILL FROM OUTPACK *9TL # JOBMILL (FROM OUTMILL) *=*= QJOBMILL *=SW BRN QJOB1 *?#G CALL 6 VJOB [X2->JOBBLOCK *?S6 ADN 2 HTIMJ-1 [INTERFACE *#?Q QJOB1 LDX 4 1(2) *#RB LDX 5 2(2) **?2 # OUTPUT (4,5) AS MMMMM.SS **QL MILFM *B== ADNC 5 500 *BPW ADN 4 0 *C9G SMO FX1 *CP6 DVD 4 N60000 *D8Q LDX 2 4 [SAVE REMAINDER *DNB MIL1 LDX 4 5 *F82 CALL 0 TENSV [Z-SUPP *FML LDX 4 2 [RESTORE *G7= SMO FX2 *GLW LDN 2 WORK8 *H6G SMO 5 *HL6 MVCH 2 0 [MOVE INTO OUTBLOCK *J5Q LDX 1 FX1 *JKB LDN 0 #36 *K52 LDX 5 4 *KJL DCH 0 0(3) *L4= BCHX 3 £ *LHW DVS 4 N1000(1) [GET X5=SECS *M3G ... DVS 4 JTEN [SPLIT *MH6 DCH 5 0(3) [TENS *N2Q BCHX 3 £ *NGB DCH 4 0(3) [UNITS *P22 BCHX 3 RETURN [EXIT *PFL # REENTER HERE *P^= RETURN *QDW SLC 3 2 *QYG SBX 7 3 *RD6 SRC 3 2 *RXQ SMO FX2 *SCB LDX 0 SAFE [START POSN *SX2 SLC 0 2 *TBL ADX 7 0 [X7 LESS NO OF CHARS USED *TW= PDCEND [END OF PDC ROUTINES *W*W CALL 0 SET124 *WTG # *X*6 # CHECK F JUSTIFIED AND SHIFT PTR S ETC *XSQ # AS NECESSARY *Y#B # *YS2 YJUST LDX 4 WHATJUST(2) *^?L LDXC 0 4 *^R= BZE 0 YEND [J IF NONE B2=W LDX 5 SAFE(2) B2QG SLC 5 2 B3=6 SLC 3 2 B3PQ SBX 5 3 B49B SRC 3 2 B4P2 NGX 5 5 [WIDTH B58L SBXC 0 5 [EXCESS B5N= BCC YJ1 B67W LDN 0 0 [ZERO EXCESS IF OVERFLOE B6MG YJ1 SBX 7 0 [CORRECTION B776 BNG 4 YLEFT [J IF L-JUST B7LQ BZE 5 YNONE [J IF NULL B86B LDX 2 SAFE(2) B8L2 LDX 3 2 B95L SLC 3 2 B9K= ADX 3 0 B=4W ... SBX 3 4 B=JG SRC 3 2 B?46 SMO 5 B?HQ MVCH 2 0 [COPY INTO FIELD B#3B BRN YEND B#H2 YLEFT SLC 3 2 B*2L ADX 3 0 [DISPLACEMENT B*G= SRC 3 2 B*^W YNONE BBFG YEND LDX 2 FX2 BB^6 LDX 4 REMAINS(2) BCDQ BRN SERTE BCYB # BDD2 # ERROR ! BDXL PARER2 BFC= SMO FX2 BFWW LDX 3 OUTCHAR [RESTORE BGBG PARER1 BGW6 LDN 2 SERR3 BH*Q NTER SMO FX2 BHTB STOZ WHATJUST [NO JUSTIFICATION BJ*2 SMO FX1 BJSL SBX 7 0(2) [CHARS BK#= BPZ 7 RINSE BKRW LDX 5 2 [SAVE BL?G SMO FX2 BLR6 STO 3 OUTCHAR [ENSURE SET OK BM=Q CALL 6 SET BMQB CALL 6 RESTART BN=2 CALL 6 RESET BNPL LDX 2 5 BP9= RINSE ADX 2 FX1 [ABS PTR BPNW LDX 1 0(2) [CHAR CNT BQ8G ADN 2 1 BQN6 MVCH 2 0(1) [MOVE MESSAGE IN BR7Q SMO FX2 BRMB NGX 0 REMAINS BS72 BPZ 0 SERTD [OUT IF AT END OF MEASSAGE BSLL BRN PDCEND BT6= PARER3 [PARAM NOT OUTPARABLE BTKW LDX 0 0(2) BW5G LDN 2 SERR2 BWK6 DCH 0 0(3) [STATE THE PDC BX4Q BCHX 3 NTER BXJB # BY42 # USEFUL S/ROUTINES:- BYHL # B^3= # FIND THE JOBBLOCK B^GW VJOB FCJOB 2,FX2,PCA,CPA,OLPA C22G EXIT 6 0 C2G6 # C2^Q # INSERT INTO (3) NEXT NONSPACES FROM 1(2) C3FB # TO A MAX OF WORD-AFTER-CALL CHARS C3^2 # 'EXITS' TO 'RETURN' C4DL # C4Y= MVCH LDX 1 0(1) [MAX CHARS C5CW MVCHA C5XG BZE 1 RETURN C6C6 SRC 1 2 C6WQ ADN 1 1(2) [PTR TO LAST+1 C7BB MVC1 SLC 1 2 C7W2 SBN 1 1 C8*L SRC 1 2 [BACKSPACE C8T= LDCH 0 0(1) C9#W SBN 0 #20 C9SG BZE 0 MVC1 [J IF SPACE C=#6 SBN 1 1(2) [CHARS TO GO IN LESS 1 C=RQ SLC 1 2 C?3J ... BNG 1 RETURN C??B ADN 2 1 C?R2 MV4 SBN 1 512 C#=L BNG 1 MV3 C#Q= MVCH 2 0 C*9W BRN MV4 C*PG MV3 MVCH 2 1(1) CB96 BRN RETURN CBNQ # CC8B # MORE PDC ROUTINES CCN2 # CD7L # CDM= QUSERNAME CF6W BRN QUSE1 [J IF NOT OUTPAR CFLG CALL 6 VJOB CG66 ADN 2 JUSER-1 [STANDARD PROCEDURE CGKQ QUSE1 LDN 0 #12 [: CH5B DCH 0 0(3) CHK2 BCHX 3 QLOCNAME [PUT NAME IN CJ4L # CJJ= # CK3W QLOCNAME CKHG CALL 1 MVCH CL36 +12 [MAX OF 12CHAR NAME CLGQ # CM2B # CMG2 QURGENCY CM^L LDCH 0 1(2) CNF= DCH 0 0(3) CNYW BCHX 3 RETURN CPDG # CPY6 # CQCQ QJOBNAME CQXB BRN QLOCNAME CRC2 CALL 6 VJOB CRWL ADN 2 JNAME-1 CSB= BRN QLOCNAME CSTW # CT*G # CTT6 QPROGNAME CW#Q LDN 0 #23 [# CWSB DCH 0 0(3) CX#2 BCHX 3 £ CXRL # CY?= # PLACE IN 4 CHARS CYQW NPUT4 ADN 2 1 C^=G MVCH 2 4 C^Q6 BRN RETURN D29Q # D2PB # D392 QLANGUAGE D3NL LDX 0 ACES D48= TXU 0 1(2) D4MW BCC RETURN [NULL IF ALL SPACEX D57G BRN NPUT4 D5M6 # D66Q # D6LB QBUDGTYPE D762 CALL 1 MVCH D7KL +8 D85= # D8JW # D94G QVARCHAR D9J6 QERRMESS D=3Q QENTRANT D=HB LDX 1 0(2) D?32 SRL 1 4 D?GL ANDN 1 #774 [CHARS IN MESSAGE D#2= BRN MVCHA [IN LESS ECXESS SPACES D#FW # D#^G # FOR USE WITH QJOBTYPE:- D*F6 XMOP 4HMOP D*YQ XBAC 4HBACK DBDB XRMOP 8HREM-MOP DBY2 XRJE 4HRJE DCCL # DCX= TYPTAB DDBW #HAL 3,+XMOP DDWG #HAL 4,+XBAC DFB6 #HAL 7,+XRMOP DFTQ #HAL 3,+XRJE DG*B # DGT2 # DH#L QJOBTYPE DHS= LDX 2 1(2) [TYPE NO DJ?W ANDN 2 3 DJRG SMO FX1 DK?6 LDX 1 TYPTAB(2) DKQQ DSA 1 2 [REL PTR DL=B SRL 1 12 [LENGTH DLQ2 ADX 2 FX1 DM9L MVCH 2 0(1) DMP= BRN RETURN DN8W # DNNG # DP86 SWIT 4HOFF DPMQ 4HON DQ7B # DQM2 QSWITCH DR6L LDX 2 1(2) DRL= SMO FX1 DS5W ADN 2 SWIT DSKG MVCH 2 3 [INPUT ON/OFF DT56 BRN RETURN DTJQ # DW4B # DWJ2 QINCNUM DX3L QTRANSCT DXH= QGENNUM DY2W QBLOCKCT DYGG QFAILCT D^26 QREPEATS D^FQ QPAGETURN D^^B QQUOTA F2F2 QREELNUM F2YL # F3D= UNUMB [UNSIGNED POS-INTEGER (S/L) F3XW LDX 4 1(2) F4CG CALL 0 TENSV [Z-SUPP F4X6 # INSERT NUMBER AFTER TENS/OCTAL CALL F5BQ NUMIN SMO FX2 F5WB LDN 2 WORK8 F6B2 SMO 5 [CHAR COUNT F6TL MVCH 2 0 F7*= BPZ 5 RETURN [J IF NOT XENOTAPE CASE F7SW LDN 0 #70 F8#G DCH 0 0(3) F8S6 BCHX 3 RETURN F9?Q # F9RB # F=?2 QBUDGQUAN F=QL QNUMA F?== QNUMB F?PW QNUMC F#9G QNUMD F#P6 # F*8Q SNUMB [+ OR - A S/L INTEGER F*NB LDX 4 1(2) FB82 CALL 0 TENSV FBML NUMINA FC7= SMO FX2 FCLW LDX 0 SIGNW FD6G BZE 0 NUMIN [J IF + FDL6 DCH 0 0(3) [ELSE PUT - IN FF5Q BCHX 3 NUMIN FFKB # FG52 # FGJL QTSNCSN FH4= LDXC 5 1(2) FHHW CALL 0 OCTALV FJ3G LDXC 0 1(2) FJH6 BCC NUMIN [J IF NOT XENOTAPE FK2Q ORX 5 GSIGN FKGB BRN NUMIN FL22 # FLFL # FL^= QPROGMILL FMDW BRN QJOB1 FMYG CALL 6 VJOB FND6 ADN 2 HCLOCKTIME-1 FNXQ BRN QJOB1 FPCB # FPX2 # FQBL QPROGCORE FQW= BRN UNUMB [J IF OUTPACK FR*W CALL 6 VJOB FRTG ADN 2 JCSIZE-1 FS*6 BRN UNUMB FSSQ # FT#B # FTS2 QPROPS FW?L LDN 5 5 FWR= BRN MONOLITH FX=W # FXQG # FY=6 QGEOPER FYPQ BRN PERPK F^9B LDX 2 FX2 F^P2 GEOPACK 4 G28L PER1 LDN 5 0 G2N= BRN MONOLITH [JUMP WITH ROUTE IN X5 G37W PERPK LDX 4 1(2) G3MG BRN PER1 G476 # G4LQ # G56B QPERITYPE G5L2 LDN 5 2 G65L PI LDX 4 1(2) G6K= BRN MONOLITH G74W # G7JG # G846 QPERINAME G8HQ LDN 5 1 G93B BRN PI G9H2 # G=2L # G=G= QSKIP [SKIP TO NEXT IDENTIFIER G=^W NULL [OUTPACK G?FG CALL 0 SET124 [SET X1 2 4 G?^6 SKIPA G#DQ LDCH 0 0(1) G#YB SBN 0 #25 G*D2 BZE 0 SERTC [J IF % G*XL SBN 0 #74-#25 GBC= BZE 0 SERRJ [OR $ GBWW BCHX 1 £ GCBG BCT 4 SKIPA GCW6 BRN SERTD [TERMINATE IF OFF END GD*Q # GDTB # GF*2 QDATETHEN GFSL LDN 5 4 GG#= BRN PI GGRW QTIMETHEN GH?G LDN 5 3 GHR6 BRN PI GJ=Q # GJQB # TO ADD TO THE CONFUSION :- GK=2 # WE NOW MUST OVERSPILL INTO A NEW SEGMENT GKPL # X5 SHALL BE A ROUTING KEY GL9= # X4 SHALL BE ANYTHING RELEVANY GLNW # GM8G MONOLITH GMN6 MFSAVE ALL GN7Q ACROSS MONOLITH,1 GNMB SENTRY2 [RETURN GP72 MFUNSAVE ALL GPLL BZE 5 RETURN GPWD ...QNULL BRN PDCEND GQ6= BRN PDCEND GQKW # GR5G # GRK6 QVARDEC GS4Q LDN 0 0 GSJB BRN VARNM GT42 QVAROCT GTHL LDCT 0 #400 GW3= VARNM SMO FX2 GWGW STO 7 OUTCHAR [HM ! GX2G LDX 7 0 GXG6 LDX 0 0(2) GX^Q SRL 0 6 GYFB DSA 0 7 [ADD TOTAL NUMBER GY^2 VARIN ADN 2 1 G^DL LDN 0 #20 G^Y= DCH 0 0(3) H2CW BCHX 3 £ H2XG BPZ 7 VDEC H3C6 LDX 5 0(2) H3WQ CALL 0 OCTALV H4BB LDN 0 #23 H4W2 DCH 0 0(3) H5*L BCHX 3 VNUMIN H5T= VDEC LDX 4 0(2) H6#W CALL 0 TENSV H6SG VNUMIN LDX 1 2 H7#6 SMO FX2 H7RQ LDN 2 WORK8 H8?B SMO 5 H8R2 MVCH 2 0 H9=L LDX 2 1 H9Q= BCT 7 VARIN H=9W SMO FX2 H=PG LDX 7 OUTCHAR H?96 BRN RETURN H?NQ # H#8B # H#N2 QOCTA H*7L QOCTB LDX 5 1(2) H*M= CALL 0 OCTALV HB6W BRN NUMINA HBLG # HC66 # WE HAVE CONCLUDED -OFF WE GO HCKQ # HD5B OFFWG LDN 4 0(3) [NEXT FREE WORD HDK2 #SKI JNLMS2 HF4L ( HFJ= LDX 2 THISPART(2) HG3W LDCT 0 #100 HGHG ORS 0 1(2) HH36 ERS 0 1(2) [CLEAR CT'D BIT IN LAST PART HHGQ ) HJ2B MHUNTW 3,GMON,BOUT HJG2 SBN 4 A1(3) HJ^L ALTLEN 3,4 HKF= # HKYW # HLDG OUTPUT [AOUT BLOCK EXISTS HLY6 [AND MDESTINY IS SET UP HMCQ MFREEW GMON,ATEMP HMXB CALL 1 SDATA HNC2 BRN OUTPUT1 HNWL FREECORE 2 [FREE DATA BLOCK IF THERE HPB= OUTPUT1 HPTW LDN 0 MKASET HQ*G ANDX 0 MARKS(2) HQT6 BZE 0 OUTOK HR#Q MFREEW GMON,ASET [AND FREE HRSB OUTOK HS#2 #DEF GDESTINY=MDESTINY HSRL ... ACROSS MONFILEA,1 [BACK TO ROUTE MESSAGE HT?= MENDAREA 1023-0? HTQW #END ^^^^ ...04353032001100000000