{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: MORNING867)}}
====== MORNING867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:DERINGD|DERINGD]], [[george:macro:FINDRET|FINDRET]], [[george:macro:FPUT|FPUT]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHACTPR|FSHACTPR]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHKILL|FSHKILL]], [[george:macro:HUNTACT|HUNTACT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INFORM|INFORM]], [[george:macro:INFORMX|INFORMX]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:MONOUTX|MONOUTX]], [[george:macro:MOPCLOSE|MOPCLOSE]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTLEN|OUTLEN]], [[george:macro:OUTMOND|OUTMOND]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPACK|OUTPACK]], [[george:macro:OUTPARC|OUTPARC]], [[george:macro:OUTPARN|OUTPARN]], [[george:macro:PCTHUNTB|PCTHUNTB]], [[george:macro:PCTMESA|PCTMESA]], [[george:macro:PHOTO|PHOTO]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SUICIDE|SUICIDE]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTUNPR|TESTUNPR]], [[george:macro:UP|UP]], [[george:macro:VFREEW|VFREEW]], [[george:macro:WHICHCON|WHICHCON]]
22FL #SEG MORNING8 [G CONSTANTINIDES
22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982
22^= #LIS K0MORNING>K0MULTIPLX>K0ALLGEO>K0GREATGEO
23DW 8HMORNING8
23YG # ENTRY POINTS
24D6 SEGENTRY K1MORNING,Z1MORNING
24XQ SEGENTRY K2MORNING,Z2MORNING
25CB SEGENTRY K3MORNING,Z3MORNING
25X2 SEGENTRY K4MORNING,Z4MORNING
26BL SEGENTRY K5MORNING,Z5MORNING
26W= SEGENTRY K7MORNING,Z7MORNING
27*W MENDAREA 30,K100MORNING
27TG [THIS ENTRY POINT OUTPUTS A 'GOOD MORNING' MESSAGE TO A MOP CONSOLE
28*6 [
28SQ ZISSUE +G3ISSUE [ISSUE NO. OF GEORGE
29#B ZMARK +G3MARK [MARK NO. OF GEORGE
29S2 ZTYPE +G4<1+3 [TYPE OF GEORGE - 3 OR 4.
2=?L K50MORNING [FOR USE BY THE GREADY MACRO.
2=R= +0
2?=W ZMESS 20H
2?QG [
2#=6 ZCONATT +CONATT,+COATIDE
2#PQ [
2*9B ZHI7020 +HI7020
2*P2 ZJTIMD +JTIMD
2B8L [
2BN= ZDEV
2C7W #HAL AMXOR+ADEVS,0
2CMG ZLIN
2D76 #HAL AMXOR+ALINES,0
2DLQ XCONBF
2F6B #HAL CONBUFF+IREMTW,0
2FL2 XA7020
2G5L #HAL A7020+CONSOUT,0
2GK= [
2H4W [THIS SUBROUTINE OUTPUTS THE "THIS IS GEO3 MARK M.N ON 31FEB84" LINE.
2HJG [
2J46 OUTMORNING
2JHQ SBX 6 1 [RELATIVISE LINK
2K3B OUTBLOCN 5
2KH2 OUTNUM ZMARK(1),0 [GEORGE MARK NUMBER.
2L2L OUTNUM ZISSUE(1),0 [GEORGE ISSUE NUMBER.
2LG= OUTPARC DATENOW
2L^W MONOUT GOODMORNING [OUTPUT MESSAGE.
2MFG ADX 6 1 [RESTORE LINK
2M^6 EXIT 6 0
2NDQ [
2NYB Z1MORNING
2PD2 LDX 4 ZLIN(1) [BLOCK TYPE. (CHARACTER BUFFERING MX)
2PXL LDX 1 AWORK4(2) [AMOP
2QC= BRN MORNG
2QWW [
2RBG Z3MORNING
2RW6 ORX 7 GSIGN [MARK TO SHOW K3 ENTRY.
2S*Q LDX 4 ZDEV(1) [BLOCK TYPE. (MESSAGE BUFFERING MXOR)
2STB LDX 1 AWORK1(2) [AMOP
2T*2 MORNG LDCT 0 #110 [MASK FOR MOPPING OFF AND ONLINE BITS
2TSL LDX 3 1
2W#= LDCT 6 #20 [MASK TO UNSET "SETTING UP" BIT.
2WRW NEXT1 LDX 1 FPTR(1) [FIND THE ENTRY IN THE ROUTING BLOCK.
2X?G BXU 4 ATYPE(1),NEXT1
2XR6 LDXC 5 7 [J. IF MX OR UX.
2Y=Q BCC NOTCC
2YQB SBX 5 A1+FOURTHWD(1) [SUBTRACT LOWEST IDE. NO.
2^=2 NOTCC SLL 5 2
2^PL ADX 1 5
329= ANDX 0 A1+FOURTHWD(1) [UNSET "SETTING UP" BIT(S) AND J.
32F4 ... ANDX 6 A1+FOURTHWD(1)
32NW ERS 6 A1+FOURTHWD(1) [IF BEING ONLINED OR MOPPED OFF.
338G BNZ 0 XMOP2
33N6 LDCT 6 2 [OUTPUT NEW LINE.
347Q STOZ AWORK4(2)
34MB OUTMOND 0,AWORK4,6
3572 CALL 6 OUTMORNING
35LL RETRY LDX 1 3 [AMOP ADDRESS.
366= NEXT2 LDX 1 FPTR(1) [FIND THE ENTRY IN THE ROUTING BLOCK.
36KW BXU 4 ATYPE(1),NEXT2
375G ADX 1 5
37K6 LDX 0 A1+FOURTHWD(1)
384Q SLC 0 2 [J. IF LINE MARKED TO BE MOPPED OFF.
38JB BNG 0 XMOP1
3942 ANDN 0 1 [J. IF ATTACHED BIT NOT SET.
39HL BZE 0 XATT
3=3= HUNTW 1,IDF,CONNAME [J. IF NO NAME BLOCK AVAILABLE.
3=GW BNG 1 NONAM
3?2G LDX 4 A1(1) [GET THE CONCEPTUAL LINE NUMBER.
3?G6 OUTBLOCN 6 [SET UP A BLOCK TO HOLD THE PARAMETER
3?^Q OUTNUM 4,0 [%A = CONCEPTUAL LINE NUMBER.
3#FB OUTPARN 12,A1+1,IDF,CONNAME [%B = CONCEPTUAL NAME.
3#RR ... LDX 6 7
3*68 ...[ SAVE TYPE INDICATOR
3*DL LDXC 7 7
3*Y= ADN 1 0
3BCW LDX 7 ZCONATT(1)
3BXG MONOUTX 7
3BY6 ... BPZ 6 XMOP15 [J IF NOT IPB
3BYQ ... MHUNTW 1,AMXOR,ADCB
3B^B ... LDX 2 A1+FPTR(1) [ADEVS ENTRY
3C22 ... LDCT 0 #200
3C2L ... ANDX 0 FOURTHWD(2)
3C3= ... BZE 0 NLAH [J IF NO LONGER ATTACHED
3C3W ... LDX 0 BIT10
3C4G ... ANDX 0 FOURTHWD(2)
3C56 ... BZE 0 XMOP15 [J UNLESS ONLINE FINISHED
3C5Q ... ERS 0 FOURTHWD(2)
3C6B ... LDX 7 IDENTNO(1) [IDENT NUMBER
3C72 ... LDX 6 CPPTR(3) [DEV LIST PTR
3C7L ... STOZ BPTR(2) [DERING ADCB
3C8= ... STOZ A1+BPTR(1)
3C8W ... FREECORE 1 [AND FREE IT
3C9G ... ACROSS ATTACHB,4 [GO TO COMPLETE ATTACHMENT
3C=6 ...NLAH NGN 0 1
3C=Q ... ERX 0 BIT10
3C?B ... ANDS 0 FOURTHWD(2) [LEAVE BIT 10 UNSET
3C#2 ... MFREEW IDF,CONNAME
3C#L ... MONOUT AHCCL [SAY ATTACHMENT CANCELLED
3C*= ... BRN XATT [CONTINUE WITH MOP
3C*W ...XMOP15
3CBG ... MFREEW IDF,CONNAME
3CC6 BRN XMOP2
3CWQ XMOP1 MONOUT JABANDMOF ["JOB ABANDONED : MOP SWITCHED OFF".
3DBB XMOP2 MOPCLOSE [WAIT FOT TRANSFERS TO FINISH.
3DDD ...XFIN
3DGG ... FSHCODE B,NOKILLA
3DJJ ...(
3DLL ... TESTUNPR NOKILLA
3DNN ... FSHKILL
3DQQ ...NOKILLA
3DSS ...)
3DWW ... SUICIDE
3D^6 ...#UNS IDFMARK8
3F4= ...NONAM WHICHCON (GEOERR),NOCON,CPPTR(3),7
3F7B ...#UNS IDFMARK8
3F=G ...#SKI
3F*L NONAM WHICHCON NOCON,CPPTR(3),7
3FT= BRN RETRY [J. BACK IN.
3G#W NOCON LDX 2 3 [LINE NO LONGER ATTACHED.
3GSG NEXT3 LDX 2 FPTR(2) [FIND THE ENTRY IN THE ROUTING BLOCK.
3H#6 BXU 4 ATYPE(2),NEXT3
3HHY ... ADX 2 5
3HRQ LDCT 0 #200
3J?B ANDX 0 A1+FOURTHWD(2)
3JR2 ERS 0 A1+FOURTHWD(2)
3K2S ... VFREEW IDF,CONNAME
3K=L BRN XATT
3KQ= [
3L9W [THIS ENTRY IS FOR THE COMMAND ISSUER ROUTINES (PERI TYPE 60).
3LPG [
3M96 Z2MORNING
3MNQ CALL 6 OUTMORNING
3MS9 ...XATT
3MXN ... FSHCODE B,NOTPRA
3N37 ...(
3N6L ... TESTUNPR NOTPRA
3N=5 ... ACROSS COMPRO,17
3N*J ...NOTPRA
3NF3 ...)
3NJG ... ACROSS COMPROA,1 [ENTER THE COMMAND PROCESSOR.
3NN2 [
3P7L [SUBROUTINES TO SET UP CONBUFF/IREMTW BLOCKS.
3PM= [
3Q6W [THIS ONE SETS UP A DUMMY BLOCK WITH A ZERO CHARACTER COUNT TO FORCE N/L
3QLG [
3R66 OUTNL SBX 7 1
3RKQ SETNCORE ICBUFF-A1,3,CONBUFF,IREMTW [DUMMY BLOCK.
3S5B LDCT 5 #37 [ROUTING PARAMETER = 3 (DON'T REROUTE
3SK2 LDX 6 AWORK1(2) [IDENTIFIER NO.
3T4L ADX 7 1
3TJ= STO 5 A1(3)
3W3W STOZ A1+1(3) [N.B. THIS PROCEDURE MAY HAVE TO BE
3WHG STO 6 A1+2(3) [CHANGED IF "CONSROOT" IS REWRITTEN.
3X36 EXIT 7 0
3XGQ [
3Y2B OUTIM SBX 7 1
3YG2 OUTBLOCN 2
3Y^L OUTPARC TIMENOW,DATENOW
3^F= LDX 5 ZJTIMD(1) ["%A %B".
3^YW BRN OUTCS [GO TO SET UP FOR OUTPUT.
42DG [
42Y6 OUTMS SBX 7 1
43CQ OUTBLOCN 4 [SET UP BLOCK TO HOLD PARAMETERS.
43XB OUTNUM ZMARK(1),0 [OUTPUT MARK NUMBER.
44C2 OUTNUM ZISSUE(1),0 [OUTPUT ISSUE NUMBER.
44LS ... OUTPARC DATENOW [CREATES A MON ASET BLOCK
44WL LDX 5 ZHI7020(1) ["GEORGE N MK%A.%B READY".
45B= [
45TW [AND THIS ONE PUTS THE START-UP MESSAGES INTO BLOCKS OF THE RIGHT LENGTH
46*G [
46T6 OUTCS LDN 1 0 [DUMMY ROUTING PARAMETER
47#Q INFORMX 1,5,0 [DONT FREE THE BLOCK
47SB FINDRET 1 [FIND RETAIN BLOCK
48#2 OUTLEN 1,3
48RL ADN 3 3
49?= SRL 3 2
49QW PHOTO 6
4==G LDX 4 1
4=Q6 SETNCORE ICBUFF-A1(3),2,CONBUFF,IREMTW [GET A BLOCK THE CONSOLE
4?9Q LDX 1 4 [OUTPUT ROUTINES CAN HANDLE, AND
4?PB TESTMOVE 6,NMV [MOVE THE ASSEMBLED MESSAGE INTO IT.
4#92 FINDRET 1 [FIND MESSAGE BLOCK
4#NL NMV LDCT 6 #37 [SET THE ROUTING PARAMETER TO 3 SO
4*8= LDN 4 A1+2(1) [THAT IF THE OUTPUT FAILS THE MESSAGE
4*MW ADX 6 3 [WILL NOT BE REROUTED ELSEWHERE.
4B7G LDN 5 ICBUFF(2)
4BM6 SMO FX2
4C6Q LDX 0 AWORK1 [N.B. THIS WORKS CURRENTLY, BUT
4CLB MOVE 4 0(3) ["CONSROOT" IS EVER REVAMPED THIS
4D62 STO 6 A1(2) [MAY HAVE TO BE CHANGED.
4DKL STOZ A1+1(2)
4F5= STO 0 A1+2(2)
4FJW FREECORE 1 [FREE THE OLD MESSAGE BLOCK.
4G4G SMO 7
4GJ6 EXIT 1 0
4H3Q [
4HHB [THIS ENTRY IS TO OUTPUT A "GOOD MORNING" MESSAGE FOR A CONSA/IREMTW ACT
4J32 [
4JGL Z4MORNING
4K2= ORX 7 GSIGN [MARKER TO INDICATE 7900 SOURCE.
4KFW LDX 3 AWORK1(2) [AMOP ADDRESS
4K^G STO 7 AWORK1(2) [IDENTIFIER NO.
4LF6 LDX 4 ZDEV(1) [AMXOR/ADEVS BLOCK TYPE.
4LYQ LDCT 7 #20
4MDB NEXT4 LDX 3 FPTR(3) [FIND THE BLOCK.
4MY2 BXU 4 ATYPE(3),NEXT4
4N58 ... SMO 6
4N=B ... ANDX 7 A1+FOURTHWD(3)
4NCL SMO 6 [UNSET THE "SETTING UP" BIT.
4NX= ERS 7 A1+FOURTHWD(3)
4PBW CALL 7 OUTIM [SET UP TIME AND DATE OUTPUT.
4PWG CALL 7 OUTMS [SET UP THE "GEORGE READY" MESSAGE.
4QB6 CALL 7 OUTNL [AND FINALLY SET UP A LINE FEED.
4QTQ ACROSS IPBCONS,1 [N.B. THE LAST MESSAGE WILL GO OUT 1S
4R*B [
4RT2 [THIS ENTRY IS TO OUTPUT "GEORGE READY" MESSAGE FOR A CONSA/APCTMESS ACT
4S#L [
4SS= [ AWORK1 ALREADY CONTAINS THE TWO LETTER TERMINAL IDENTIFIER.
4T?W [
4TRG Z5MORNING
4TW5 ... FSHCODE B,XNOPRA
4TYN ...(
4W3? ... FSHACTPR
4W5W ...XNOPRA
4W8F ...)
4W?6 CALL 7 OUTNL [LINE-FEED OUTPUT.
4WQQ PCTMESA [CONVERT TO 7020 OUTPUT BLOCKS.
4X=B CALL 7 OUTMS [SET UP THE "GEORGE READY" MESSAGE.
4XQ2 PCTMESA [CONVERT TO 7020 OUTPUT BLOCKS.
4Y9L CALL 7 OUTIM [SET UP TIME AND DATE OUTPUT.
4YP= PCTMESA [CONVERT TO 7020 OUTPUT BLOCKS.
4^8W MHUNTW 3,A7020,CONSIN [GET THE UNIQUE IDENTIFIER FOR THE
4^NG LDX 2 3 [TERMINAL,
5286 LDEX 4 APCTID(3) [PUT IT IN EACH CONSOUT BLOCK AND
52MQ PCTHUNTB 3 [CHAIN THE BLOCKS IN SEQUENCE
537B DERINGD FPTPCT(2) [AFTER THE INFORM BLOCK.
53M2 SMO 4 [AND FLIP CONSOLE OUTPUT.
546L LDCH 0 APCTX(3)
54L= SMO 4
555W LDX 7 IDUNIQUE(3)
55KG SMO 4
5656 ORS 0 APCTD(3)
56JQ XBACK LDX 2 FPTR(2)
574B LDX 0 ATYPE(2)
57J2 BXGE 0 CACT,XOUT [J. IF NO MORE BLOCKS TO CHAIN.
583L BXE 0 XCONBF(1),XFOUN
58H= BXU 0 XA7020(1),XBACK
592W STO 7 CIDENTM(2)
59GG XFOUN CHAIN 2,3
5=26 BRN XBACK
5=FQ XOUT LDX 0 BPTPCT(3) [J. UNLESS RING EMPTY.
5=^B SBN 0 FPTPCT(3)
5?F2 BNZ 0 XFIN
5?YL HUNTACT AMOP,2,3 [FIND THE PCY ACTIVITY.
5#D= LDX 0 GSIGN [J. IF NOT ASLEEP.
5#XW ANDX 0 AWORK1(2)
5*CG BZE 0 XFIN
5*X6 ERS 0 AWORK1(2) [OTHERWISE WAKE IT UP.
5BBQ FPUT
5BWB BRN XFIN [END.
5CB2 [
5CTL [
5D*= Z7MORNING [ENTRY FROM SETUP TO OUTPUT CENTRAL
5DSW LDX 3 K50MORNING(1) [NO. OF WORDS IN OPTIONAL ADDITION.
5F#G OUTBLOCN 7(3) [SET UP GMON/ASET BLOCK LONG ENOUGH.
5FS6 LDX 3 1 [CAN'T USE X1 TO MODIFY IN OUTPACK.
5G?Q OUTPACK ZTYPE(3),1,NUMA [3 OR 4.
5GRB LDX 3 1
5H?2 OUTPACK ZMARK(3),1,NUMB [MARK NO.
5HQL LDX 3 1
5J== OUTPACK ZISSUE(3),1,NUMC [ISSUE NO.
5JPW LDX 3 1
5K9G LDX 2 K50MORNING(1) [J IF NO ADDITIONAL MESSAGE REQUIRED
5KP6 BZE 2 NOXTRAMESS
5L8Q OUTPACK ZMESS(3),0(2),VARCHAR [USER DEFINED ADDITIONAL MESSAGE
5LNB NOXTRAMESS
5M82 INFORM 1,GREADY,1
5MML UP
5N7= #END
^^^^ ...45614220000100000000