MORNING867
(George Source)
Macros used: ACROSS, BXE, BXGE, BXU, CHAIN, DERINGD, FINDRET, FPUT, FREECORE, FSHACTPR, FSHCODE, FSHKILL, HUNTACT, HUNTW, INFORM, INFORMX, MENDAREA, MFREEW, MHUNTW, MONOUT, MONOUTX, MOPCLOSE, OUTBLOCN, OUTLEN, OUTMOND, OUTNUM, OUTPACK, OUTPARC, OUTPARN, PCTHUNTB, PCTMESA, PHOTO, SEGENTRY, SETNCORE, SUICIDE, TESTMOVE, TESTUNPR, UP, VFREEW, WHICHCON
- MORNING867.txt
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