{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: MONFIL865)}}
====== MONFIL865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BXL|BXL]], [[george:macro:CATMASK|CATMASK]], [[george:macro:ERROR|ERROR]], [[george:macro:FCJOB|FCJOB]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOPACK|GEOPACK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFPDCTAB|MFPDCTAB]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MFSAVE|MFSAVE]], [[george:macro:MFUNSAVE|MFUNSAVE]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NEXTPART|NEXTPART]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:RESET|RESET]], [[george:macro:RESTART|RESTART]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:TIMECON2|TIMECON2]]
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