LOADFIN860
(George Source)
Macros used: ACROSS, ADDRECS, ALTLEN, ASSILO, BACKSPACE, CHAIN, CHANGEFILE, CLEAR, CLOSE, DOWN, FINDACTNO, FJOCA, FPCACA, FPERENTA, FREECORE, GETWORD, GSCAN, HUNT2, HUNTW, LINKSET, LOCK, MACCS, MENDAREA, MFREE, MHUNT, MHUNTW, MONOUT, NAME, OUTBLOCK, OUTMESS, OUTNULL, OUTPACK, OUTPARAM, OUTPARC, OUTPMILL, PAIR, PERCOUNT, PERMITBRK, PMT, PROGEND, READ, RUNPROG, SEG, SEGENTRY, SETNCORE, STEP, UNLOCK, UPPLUS, VFREEW, WORDFIN
- LOADFIN860.txt
22FL SEG LOADFIN,70,RUTH PORTER 22^= # 23DW # 23YG SEGENTRY K1LOADFIN,XENT1 24D6 #SKI G4 24XQ ( 25CB SEGENTRY K41LOADFIN,XENT41 25X2 SEGENTRY K42LOADFIN,XENT42 26BL ) 26W= # 27*W # THE SEGMENT DEALS WITH THE ENTRY BLOCK OF THE PROGRAM BEING LOADED AND 27TG # FINISHES THE LOADING PROCESS. 28*6 # IT INSERTS THE PROGRAMS ENTRY POINT,DEALS WITH 28SQ # THE LOAD PERIPHERAL BIT IN WORD 2 OF THE R/S AND FINALLY CLOSES ANY 29#B # FILES OPENED FOR LOADING AND EXITS TO COMMAND LEVEL. 29S2 # 2=?L # 2=R= #DEF XLDEX=EXTPS+3 2?=W #DEF XLDEXA=EXTPS+4 2?QG #DEF YCOUNT=EXTPS 2#=6 # 2#PQ RESMASK #77000077 [R/S MASK FOR TYPE WORD 2*9B REQUEST #73000001 [R/S TYPE WORD 2*P2 SUPRES #73000006 [SUPPLEMENTARY R/S TYPE WORD 2B8L N14 14 2BN= TWFOUR +24 [LENGTH OF R/S PLUS SUPP. R/S 2C7W # 2CMG # LINK PAIRS FOR OLPA AFTER CONT - PROBABLY UNSATISFACTORY 2D76 PTR PAIR TROBJ,1 2DLQ PCR PAIR CROBJ,1 2F6B PMT PAIR MTOBJ,1 2FL2 PHALT 4HLD [HALTED MESSAGE 2G5L # 2GK= # LABELS OF ERROR MESSAGES 2H4W WERRES +GWERRES 2HJG XMBLCNT +JBLCNT 2J46 # 2JHQ # 2K3B # 2KH2 [ CLEARS THE EXTPS WDS FOR GETWORD ETC 2L2L ZCLEAR 2LG= SMO FX2 2L^W LDN 1 EXTPS 2MFG LDN 2 1(1) 2M^6 STOZ 0(1) 2NDQ MOVE 1 4 2NYB EXIT 4 0 2PD2 # 2PXL # 2QC= # 2QWW SUSP 2RBG # 2RW6 # ROUTINE TO SIMULATE HALTED LD IF WE HAVE A SUSPEND TYPE ENTRY BLOCK 2S*Q # 2STB SBX 5 FX1 2T*2 LDN 4 6 [PREPARE A SIX WORD 2TSL OUTBLOCK 4 [MONOUT BLOCK 2W#= OUTPARC JOBMILL [PREPARE MILL TIME FOR OUTPUT 2WRW OUTNULL [NO MEMBER NUMBER SO OUTPUT SPACE 2X?G SETNCORE 4+APEDSP1-A1,3,APED,ANEVENT 2XR6 [SET UP CORE FOR EVENT BLOCK 2Y=Q STOZ APEDSP1(3) [ZEROISE MEMBER NUMBER WORD 2YQB LDN 0 APEDHALT [INSERT 2^=2 STO 0 APEDSP1+1(3) [CATEGORY WORD 2^PL LDN 0 2 [PUT IN CHARACTER COUNT 329= STO 0 APEDEVEM(3) [INTO APEDEVEM 32NW LDX 0 PHALT(1) [NOW INSERT THE MESSAGE 338G STO 0 APEDSP1+3(3) 33N6 OUTPARAM APEDEVEM(3),APEDSP1+3,APED,ANEVENT 347Q MONOUT HUSH2 [OUTPUT HALTED MESSAGE 34MB ADX 5 FX1 3572 EXIT 5 0 35LL # 366= # 36KW # 375G # 37K6 XENT1 384Q #SKIP G4 38JB ( 3942 FPCACA 2 [CLEAR ANY LOCKDOWN COUNTS LEFT SET 39HL CLEAR 2,0,,2,2 3=3= ) 3=GW MHUNTW 1,FILE,FRB [ENTRY BLOCK 3?2G LDX 7 A1(1) [SPECIFIER WD 3?G6 LDX 6 A1+1(1) [ENTRY PT FOR TYPES 2,3 3?^Q LDX 5 A1+2(1) [BLOCK COUNT IF 4 WDS LONG 3#FB FREECORE 1 3#^2 # FOR ALL EXCEPT EDS WE HAVE COUNTED THE NO OF BLOCKS 3*DL LDCT 0 2 3*Y= ANDX 0 XLDEXA(2) 3BCW BNZ 0 NEL [EDS 3BXG LDX 4 YCOUNT(2) 3CC6 ANDX 4 BSP16 [NO OF RECORDS READ 3CWQ # IF THE ENTRY BLOCK IS 4 WDS LONG WE CHECK THE BLOCK COUNT 3DBB LDX 0 7 3DW2 SRL 0 12 3F*L ANDN 0 #77 [LENGTH OF ENTRY BLOCK IN X0 3FT= SBN 0 4 3G#W BNG 0 RBOK [NOT 4.WDS 3GSG # IF CONT WE MUST ADJUST THE BLOCK COUNT TO ALLOW FOR R/S 3H#6 # AND PERHAPS SUPP R/S 3HRQ LDCT 0 #200 3J?B ANDX 0 XLDEXA(2) 3JR2 BZE 0 RELOC [NOT CONT 3K=L # THIS IS THE BEST WE CAN DO TO GUESS IF THERE IS A SUPP R/S IN B/D - 3KQ= # NET FOOLPROOF 3L9W FPCACA 1,2 3LPG LDX 0 ARM1(1) 3M96 ANDN 0 #77 3MNQ BZE 0 RELOP1 [JUMP IF IN ORDINARY MODES 3N8B SBN 5 1 [TO ALLOW FOR NO SUPPLEMENTARY REQUES 3NN2 RELOP1 3P7L SBN 5 1 [TO ALLOW FOR NO REQUEST SLIP 3P8D ... SBX 5 4 3P9= ... BZE 5 RBOK [J IF COUNT OK. 3P=4 ...[ 3P=W ...[ ALTHOUGH WE SUBTRACTED 1 FOR ORDINARY MODES & 2 FOR EXTENDED 3P?N ...[ MODES TO CATER FOR R/S & SUPPLEMENTARY R/S,THE CURRENT MODE OF 3P#G ...[ THE PROGRAM MAY BE DIFFERENT TO THE ORIGINAL MODE : IN WHICH CASE 3P*# ...[ WE MIGHT ONLY REQUIRE TO SUBTRACT 1 RATHER THAN 2(OR VICEVERSA) 3PB6 ...[ FOR R/S REASONS.SO WE ALLOW A 1 DEVIATION ON CORRECT BLOCKCOUNT 3PBY ...[ IN THE RIGHT DIRECTION TO ALLOW FOR THIS. 3PCQ ...[ 3PDJ ... BZE 0 XORD [J IF ORDINARY MODES 3PFB ... ADN 5 1 [AS ORIG.MODE MAY HAVE BEEN ORD. 3PG8 ... BZE 5 RBOK [WE MAY HAVE SUBTRACTED 1 TO MANY 3PH2 ... BRN XBLCNT [J AS DEFINATE ERROR 3PHS ...XORD 3PJL ... SBN 5 1 [AS ORIG.MODE MAY HAVE BEENEXTND. 3PKD ... BZE 5 RBOK [WE MAY HAVE SUBTRACTED 1 TO LESS 3PL= ... BRN XBLCNT [J AS DEFINATE ERROR 3PM= RELOC 3Q6W SBX 5 4 [TEST TO SEE IF BLOCK COUNT IS OK 3QLG BNZ 5 XBLCNT [ERROR IN BLOCK COUNT 3R66 RBOK 3RKQ # UPDATE CP'S RECORD COUNT FOR EMBEDDED LOAD 3S5B LDCT 0 #40 3SK2 ANDX 0 XLDEXA(2) 3T4L BZE 0 NEL 3TJ= ADDRECS 3,4 3W3W NEL 3WHG ANDN 7 #77 [ENTRY BLOCK TYPE IN X7 3X36 SBN 7 4 3XGQ FPCACA 1,2 3Y2B MACCS ,1,3 [ADDRESS OF ACC 0 IN X3 3YG2 # IF NOT A TYPE 4 BLOCK THE ENTRY POINT MUST BE STORED IN WORD 8 3Y^L BZE 7 RENTB [NOT TYPE 4 3^F= STO 6 8(3) [ENTRY POINT STILL IN X6 3^YW RENTB 42DG #SKIP G4 42Y6 ( 43CQ LDN 0 #4000 [JUMP IF INITIAL LOAD OF PP 43XB ANDX 0 XLDEXA(2) 44C2 BNZ 0 PPLOAD 44WL ) 45B= RENTC 45TW ADN 7 1 [X7 =0 IF SUSPEND ENTRY BLOCK 46*G FJOCA 3,FX2 46T6 LDN 0 #11 47#Q ERS 0 JMISC(3) [CHANGE STATE FR STOPPED TO DORMANT 47C* ...#UNS ISTDP 47FY ...( 47JH ... LDX 0 APROCTIME 47M6 ... STO 0 JCTLR(3) [TO WARD OFF TRUE DORMANCY 47PP ...) 47SB LDCT 0 #200 48#2 ANDX 0 XLDEXA(2) 48RL BZE 0 REND [NOT CONT 49?= # FOR CONT WE MUST SET THE ACTIVITIES BACK FOR NEXT PERI 49QW LDX 4 XLDEXA(2) [IS ONLINE MARK SET 4==G BNG 4 RENDC [JUMP IF ONLINE 4=Q6 FINDACTNO 3,XLDEX(2) [FIND OLPA 4?9Q LOCK 3 4?PB CHANGEFILE 3 4#92 UNLOCK 3 4#NL # PICK UP PERIPHERAL TYPE FROM OLPA 4*8= LDX 4 FTYPNO(3) 4*MW SRL 4 15 4B7G BNZ 4 NTR [NOT TR 4BM6 ADN 1 PTR 4C6Q BRN ZINS 4CLB NTR 4D62 SBN 4 3 4DKL BNZ 4 NCR [NOT CR 4F5= ADN 1 PCR 4FJW BRN ZINS 4G4G NCR 4GJ6 ADN 1 PMT [MUST BE MT 4H3Q ZINS 4HHB LINKSET 3,0(1) 4J32 RENDC 4JGL # BREAKIN HAS BEEN INHIBITED FOR CONT 4K2= PERMITBRK 4KFW CALL 4 ZCLEAR 4K^G BZE 7 SUS [SUSPEND ENTRY BLK 4LF6 RUNPROG [RESTART PROGRAM 4LYQ SUS 4MDB CALL 5 SUSP 4MY2 PROGEND 4NCL REND 4NX= # 4PBW # CORE MESSAGE OUTPUT HERE 4PWG # 4QB6 FPCACA 2 4QTQ HUNT2 3,AOBRES,0,2 4R*B LDX 0 ALOGLEN(3) 4RT2 SBN 0 24 4S#L BNZ 0 PLJ [JUMP IF NO SUPP RQS 4SS= LDX 4 A1+17(3) 4T?W SLL 4 3 4TRG LDN 0 4 4W?6 LDX 3 2 [PRESERVN PCA PTR 4WQQ LDCT 1 #600 4X=B ADX 3 1 4XQ2 DCH 4 ALMT(3) 4Y9L LDN 6 3 4YP= PUT 4^8W DCH 4 ARM4(3) [SET UP MODES IN CHAR 3 4^NG SBN 3 K61 5286 BCT 6 £ 52MQ BCT 0 PUT 537B PLJ 53M2 #SKIP G4 546L ( 54L= HUNT2 2,BSTB,BSCB [IN GEORGE 4 THE SIZE OF THE PROGRAM 555W LDX 6 AMAXSIZE(2) [SIZE OF PROG PICKED UP FROM SCB 55KG DOWN STARTSCI,1 5656 ) 56JQ LDN 4 12 [PREPARE A 12 WORD 574B OUTBLOCK 4 [MONOUT BLOCK. 57J2 #SKIP G4 583L ( 58H= LDX 4 6 [SAVE DENSE/SPARSE BIT 592W SLL 6 10 [CONVERT SIZE TO PAGES 59GG ) 5=26 # OUTPUT MILL TIMES AND REAL TIME 5=FQ #SKIP G3 5=^B OUTPARC PROGCORE [OUTPUT CORESIZE 5?F2 #SKIP G4 5?YL OUTPACK 6,1,PROGCORE 5#D= OUTPARC JOBMILL,TIMENOW 5#XW #SKIP G4 5*CG ( 5*X6 BPZ 4 NSPARSE [IF PROG IS SPARSE INDICATE THIS 5BBQ OUTMESS CORESP [IN THE CORE/SIZE GIVEN MESSAGE 5BWB NSPARSE 5CB2 ) 5CTL OUTPMILL 5D*= MONOUT CORE [MESSAGE MONITORED 5DSW PERCOUNT 5F#G LDCT 7 #40 5FS6 ANDX 7 XLDEXA(2) 5G?Q BZE 7 YLP [NOT SAVED FILE LOAD 5GRB # AN OLD TYPE OF SAVED FILE MAY EXIST WITH A REDUNDANT R/S 5H?2 STEP 5HQL BZE 3 PSAVE [BACKSPACE IF END OF FILE MARKER 5J== LDCH 0 2(3) 5JPW SBN 0 #73 [1ST CHAR OF B/D REC 5K9G BNZ 0 PSAVE [REPOS FILE 5KP6 LDN 4 1 5L8Q ADDRECS 3,4 5LNB YLP 5M82 FPCACA 3,2 5MML HUNT2 3,AOBRES,0 5N7= LDCT 5 #600 [TO EXTRACT 5NLW ANDX 5 A1+2(3) [LOAD PERIPHERAL BITS 5P6G LDX 4 5 [NOTE THE LOAD-PERIPHERAL MARKERS 5PL6 ANDX 5 GSIGN [SINGLE OUT GPL LOAD PERIPHEPAL BIT 5Q5Q ERS 5 A1+2(3) [REMOVE IT IF SET 5QKB ERS 5 A1+13(3) [AND ALTER CHECKSUN ACCORDINGLY 5R52 LDX 0 A1+5(3) 5RJL STOZ A1+5(3) [CLEAR OVERLAY WORD AS CAN UPSET SAVE 5S4= ADS 0 A1+13(3) [ADJUST CHECKSUM 5SHW BNZ 7 ZSEND [JUMP IF SAVED FILE LOAD 5T3G BZE 4 ZCLUP [IF NO LP BITS - BRANCH 5TH6 BNG 4 XASS [J IF GPL 5W2Q MHUNT 1,FILE,ENT 5WGB LDX 5 ETM(1) 5X22 LDCT 6 #377 [GET FILE TYPE 5XFL ANDX 5 6 5X^= HUNT2 3,APERI,APERIRES 5YDW FPERENTA 3,5,XASS [J IF UNASSIGNED 5YYG BRN ZCLUP 5^D6 XASS 5^XQ ASSILO ZCLUP [ASSIGN THE LOAD PERIPHERAL TO THE PR 62CB BRN ZSEND 62X2 # FROM ZUPS TO ZSEND SHOULD BE OMITTED IF NO ERROR ON RESTORING OLD SA 63BL # FILE IS REPORTED IN MK6 63W= ZUPS READ [GET THE NEXT RECORD 64*W MHUNTW 3,FILE,FRB [FIND THE READ BLOCK 64TG LDX 4 A1(3) [IS THERE A RECORD? 65*6 BZE 4 PSAVE [POINT TO THE END OF THE FILE 65SQ SBN 4 2 [(A NULL RECORD HAS JUST A REC. HEAD) 66#B BZE 4 ZSEND [IF NOT - LEAVE THE R1S AS IT IS 66S2 TXL 4 N14(1) 67?L BCS PSAVE [LONG? - IF NOT BACKSPACE & GO UP 67R= LDX 0 A1+2(3) [IS THE RECORD READ A R/S? 68=W ANDX 0 RESMASK(1) [ISOLATE THE FIRST AND FOURTH CHARS. 68QG TXU 0 REQUEST(1) [IS IT #73----01? 69=6 BCS PSAVE [IF NOT - WE FINISH 69PQ TXU 4 TWFOUR(1) [RECORD LENGTH =24? 6=9B BCS ZLENK [IF NOT - WE HAVE ONLY A R/S 6=P2 LDX 0 A1+18(3) [IF SO - GET THE WORD ON END OF R/S 6?8L ANDX 0 RESMASK(1) [ISOLATE FIRST AND LAST CHARACTER 6?N= TXU 0 SUPRES(1) [TEST AGAINST THE STANDARD SUPP. R/S 6#7W BCC ZLINK [BRANCH IF NO SUPP- R/S 6#MG ZLENK LDN 4 16 [TO GET AN ORDINARY RECORD LENGTH 6*76 ZLINK LDN 6 A1+2(3) [MOVE THE RECORD 6*LQ LDN 7 A1(3) [UP TO THE HEAD OF 6B6B SMO 4 [THE FILE APPEND 6BL2 MOVE 6 0 [BLOCK 6C5L ALTLEN 3,4 [SHORTEN THE BLOCK ACCORDINGLY 6CK= FPCACA 1,FX2 6D4W HUNT2 3,AOBRES,0,1 6DJG MHUNTW 2,FILE,FRB [FIND THE FILE READ BLOCK 6F46 LDX 4 2 [REMEMBER FILE READ BLK ADDRESS 6FHQ CHAIN 2,3 [CHAIN IT AFTER THE AOBRES 6G3B NAME 4,AOBRES [RENAME IT AOBRES 6GH2 FREECORE 3 [AND FREE THE ORIGINAL AOBRES BLOCK 6H2L ZSEND 6HG= GSCAN JOBNO(2),CLOAD,,J [SCAN THE JOB NUMBER 6H^W LDX 0 BIT9 6JFG SMO FX2 6J^6 ANDX 0 XLDEXA 6KDQ BZE 0 XNOCPB [IF LOAD WAS DELAYED,WE MUST FREE 6KYB MFREE CPB,CUNI [CPB/CUNI CONTAINING FILE NAME 6LD2 XNOCPB 6LXL VFREEW FILE,ENT 6MC= CALL 4 ZCLEAR 6MWW UPPLUS 2 6NBG PSAVE BACKSPACE [BACK OVER THE LAST RECORD 6NW6 BRN YLP 6P*Q # 6PTB # 6Q*2 ZCLUP 6QSL #SKIP G4 6R#= ( 6RRW LDN 0 #2000 [IF IT IS THE SUBSEQ LOAD OF A 6S?G ANDX 0 XLDEXA(2) [PURE PROCEDURE THERE IS NO FILE 6SR6 BNZ 0 ZSEND [TO CLOSE 6T=Q ) 6TQB CLOSE [LOAD FILE 6W=2 BRN ZSEND 6WPL XBLCNT 6X9= LDN 1 XMBLCNT 6XNW BRN RERROR 6Y8G RERROR 6YN6 SMO FX1 6^7Q LDX 5 0(1) [ADDR OF ERROR MESSAGE 6^MB ACROSS LOADERR,2 7272 # 72LL # THIS SECTION DEAL WITH THE LOADING OF PURE PROCEDURES 736= # 73KW #SKIP G4 745G ( 74K6 PPLOAD 754Q ACROSS LOADPP,1 [ENTER LOADPP TO SET UP SUD 75JB XENT41 [RETURN FROM LOADPP WITH PROG STOPPED-NOT USED CURRENTLY 7642 FPCACA 1,2 76HL MACCS ,1,3 773= BRN RENTC [REJOIN NORMAL LOAD PATH 77GW XENT42 [RETURN FROM LOADPP WITH PROG DORMANT-THIS ENTRY IS USED 782G [IN BOTH INITIAL & SUBSEQ LOADS OF A PURE PROCEDURE 78G6 LDX 0 XLDEXA(2) 78^Q ANDN 0 8 79FB BNZ 0 REND [JUMP IF PP SETS UP ITS OWN ACCS. 79^2 HUNTW 1,APED,ADELETE 7=DL BNG 1 REND [IF NO ADELETE BLOCK JOIN NORMAL PATH 7=Y= LDN 0 0 [OBJ PROG ADDRESS 7?CW LDN 6 8 [NO OF WORDS 7?XG LDX 5 EXTPS+1(2) [SAVE EXTPS+1 & ZEROISE IT 7#C6 STOZ EXTPS+1(2) [READY FOR GETWORD 7#WQ GETWORD 0,7,WRITE,6,6 [OBTAIN FIRST 8 WORDS OF OBJ.PROG 7*BB SBN 6 8 7*W2 BNG 6 (GEOERR) 7B*L MHUNTW 1,APED,ADELETE 7BT= LDN 6 APEDACC(1) [MOVE IN ACCUMULATORS 7C#W MOVE 6 8 7CSG WORDFIN 7D#6 STO 5 EXTPS+1(2) 7DRQ BRN REND [REJOIN NORMAL LOAD PATH 7F?B ) 7FR2 MENDAREA 40,K99LOADFIN 7G=L #END ^^^^ ...51017767000100000000