(George Source)
Macros used: ACROSS, ALTLENG, BITDEFS, BXGE, BXL, CHADCON, CHNUMCON, COMBRKIN, COMERRX, DOWN, ENDCOM, ERRORX, GEOERR, HUNTW, JBC, JBS, JMBS, MFREE, MHUNT, MHUNTW, PARAFREE, PARANUMB, PARAPASS, PARSPLIT, SEGENTRY, SETNCORE, SPARANXT, STOREN, STOREX, TESTREP, UP, UPPLUS
22FL #LIS 3 22^= #SEG JOBDATAB 23DW 8HJOBDATAB 23YG [ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982 24D6 [ 24XQ [ 25CB [ THIS SEGMENT CONTAINS ROUTINES& SUBROUTINES WHICH USE TO BE 25X2 [ IN 'JOBDATA'. THE LOGIC FLOW OF THIS SEGMENT IS IDENTICAL 26BL [ TO THE OLD 'JOBDATA' SEGMENT AND SOME DUPLICATION OF CODE 26W= [ EXISTS TO SAVE CHAPTER THRASHING. 27*W [ THIS SEGMENT HAS BEEN CONSTRUCTED SO THAT ADDITIONAL 27TG [ ROUTINES FROM 'JOBDATA' CAN BE ADDED AT A FUTURE DATE 28*6 [ IF NECESSARY: OCT 1981. 28SQ # 29#B # ENTRY POINT 29S2 # 2=?L SEGENTRY K1JOBDATAB,XK1 ['P' ROUTINES 2=R= SEGENTRY K2JOBDATAB,XK2 [ERROR ENTRY 2?=W SEGENTRY K3JOBDATAB,XK3 [STARTTIME ROUTINE 2?QG 2#2# ... BITDEFS AWORK4,0,TMAXSIZE [ B7270 CORRECTION 2#=6 BITDEFS AWORK4,2,TFORMAT,STARTCOM,SIGNEED 2#PQ BITDEFS AWORK4,5,SINGLE,TMINUS,TPLUS,PMINUS 2*9B YER2 +JPARNULL 2*P2 YER3 +JPARMIS 2B8L YER4 +APFERR 2BN= YER5 +ERMCH 2C7W YER8 +JDOVERFLOW [TOO MUCH SCHED, DATA 2CMG YER9 +JDTSNER [MT ERROR 2D76 YER10 +JDNOCOUNT 2DLQ TOOSMALL 3 2F6B TOOBIG 502 2FL2 Z2CLOCKANUM #10005 [CORRESPONDS TO XX.XX 2G5L Z3CLOCKANUM #10010 [CORRESPONDS TO XX.XX.XX 2GK= ZHR 4HHRS 2H4W MIN 4HMINS 2HJG SEC 4HSECS 2HL9 ...[ B7270 CORRECTION 06.08.82 2HMY ...[ SET UP ROUNDING VALUES 2HPM ...#SKIP G3 2HRB ...#DEF PROGRND = 64 2HT5 ...#SKIP G4 2HWS ...#DEF PROGRND = 1024 2HYH ...MAXSIZE #20000000 2J2= ...PROGRNDN -PROGRND 2J46 # 2JHQ XK1 2K3B [ 2KH2 SMO 3 2L2L BRN SWITCH 2LG= SWITCH 2L^W BRN PERROR [FACILITY 0 2MFG BRN PERROR [FACILITY 1 2M^6 BRN PCLOCK [FACILITY 2 2NDQ BRN PDATELOAD [FACILITY 3 2NYB BRN PINTEGER [FACILITY 4 2PD2 BRN PERROR [FACILITY 5 2PXL BRN PERROR [FACILITY 6 2QC= BRN PERROR [FACILITY 7 2QWW BRN PDEADLINE [FACILITY 8 2RBG BRN PSTRING [FACILITY 9 2RW6 BRN PERROR [FACILITY 10 2S*Q BRN PTSN [FACILITY 11 2STB BRN POCTAL [FACILITY 12 2T*2 PERROR 2TSL GEOERR 1,JOBDATAB 2W#= [ ROUTINES TO PICK UP NEXT COMMAND PARAMETER 2WRW [ AND LEAVE IN A CPB/CUNI . 2X?G [ X0 - ANUM, X7 = LINK, X3-> CPB/CUNI ON EXIT 2XR6 [ SPARA & RSPARAPASS KEEP SPACES 2Y=Q [ PARA & RPARAPASS REMOVE SPACES 2YQB SPARA ORX 5 GSIGN 2^=2 RSPARAPASS 2^PL JBS RPS7,2,SINGLE 329= SBX 5 FX1 32NW SPARAPASS 338G BRN RPS5 33N6 PARA ORX 5 GSIGN 347Q RPARAPASS 34MB JBS PARA1,2,SINGLE [J IF PARM IN CUNI 3572 SBX 5 FX1 35LL PARAPASS 366= RPS5 ADX 5 FX1 36KW RPS7 MHUNT 3,CPB,CUNI 375G STO 3 ACOMMUNE3(2) 37K6 RPS8 LDX 1 FX1 384Q LDX 0 ANUM(3) 38JB LDXC 5 5 3942 BCS RPS9 39HL BZE 0 PNULL [J IF NULL PARAM 3=3= BNG 0 PABS [J IF PARAM ABSENT 3=GW RPS9 EXIT 5 0 3?2G [ REMOVE SPACES FROM CPB/CUNI 3?G6 PARA1 MHUNT 3,CPB,CUNI 3?^Q STO 3 ACOMMUNE3(2) 3#FB LDX 1 3 3#^2 STO 5 GEN0 3*DL LDX 5 ANUM(3) 3*Y= ANDN 5 #7777 3BCW BZE 5 PARA7 [J IF NO DATA 3BXG PARA2 LDCH 0 APARA(1) 3CC6 DCH 0 APARA(3) [KEEP NON-SPACE CHARS. 3CWQ SBN 0 #20 3DBB BZE 0 PARA6 [J IF SPACE 3DW2 PARA5 BCHX 3 £ 3F*L PARA6 BCHX 1 £ 3FT= BCT 5 PARA2 3G#W SLC 1 2 3GSG SLC 3 2 3H#6 SBX 1 3 3HRQ LDX 3 ACOMMUNE3(2) [PTR->CPB/CUNI 3J?B SBS 1 ANUM(3) [ADJUST CHAR. COUNT 3JR2 PARA7 LDX 5 GEN0 3K=L BRN RPS8 3KQ= [ ROUTINE TO PUT DATA INTO ADATA/CSTORE 3L9W [ X6 IS LINK 3LPG [ ON EXIT, X3 HOLDS DATA 3M96 STOREX [DATA HELD IN X7 3MNQ LDX 3 7 3N8B LDN 7 1 [COUNT OF WORD TO BE STORED 3NN2 ORX 6 GSIGN [STOREX ENTRY INDICATOR 3P7L STOREN [DATA HELD IN CPB/CUNI 3PM= [ IF ENTERED AT STOREN, DATA IS IN CPB/CUNI 3Q6W [ X7 HOLDS COUNT OF WORDS TO BE STORED 3QLG SBX 6 FX1 3R66 CALL 1 SCSTORE [SET X2 ->ADATA/CSTORE 3RKQ BPZ 2 STO2 [J IF ADATA/CSTORE EXISTA 3S5B SETNCORE 10,2,ADATA,CSTORE 3SK2 LDN 0 A1+2 3T4L STO 0 A1(2) [PTR->NEXT FREE WORD 3TJ= STO 0 A1+1(2) 3W3W STO2 LDX 0 ALOGLEN(2) 3WHG ADN 0 A1 3X36 SBX 0 A1(2) 3XGQ SBX 0 7 3Y2B BPZ 0 STO4 [J IF ENOUGH ROOM IN CSTORE 3YG2 LDX 4 ALOGLEN(2) 3Y^L SBX 4 0 3^F= ALTLENG 2,4,SCSTORE [INCREASE LEGTH OF CSTORE 3^YW CALL 1 SCSTORE [SET X2->ADATA/CSTORE 42DG STO4 ADS 7 A1(2) [UPDATE PTR TO NEXT FREE WORD 42Y6 ADX 2 A1(2) 43CQ SBX 2 7 43XB STO 3 0(2) [STO DATA IN STOREX CASE 44C2 LDXC 6 6 44WL BCS STO9 [J IF STOREX CASE 45B= MHUNT 1,CPB,CUNI 45TW LDN 1 APARA(1) 46*G SMO 7 46T6 MOVE 1 0 [STORE DATA IN STOREN CASE 47#Q STO9 ADX 6 FX1 47SB LDX 1 FX1 48#2 LDX 2 FX2 48RL EXIT 6 0 49?= SCSTORE 49QW MHUNTW 2,ADATA,CSTORE 4==G EXIT 1 0 4=Q6 # 4?9Q RCLOCK 4?PB # THIS S/R CONVERTS A TIME GIVEN IN 24HR CLOCK FORMAT,XX.XX,INTO MINUTES 4#92 # MIDNIGHT. 4#NL # 4*8= SBX 6 FX1 4*MW CALL 5 RPARAPASS 4B7G ADX 6 FX1 4BM6 RCL0 TXU 0 Z2CLOCKANUM(1) 4C6Q BCC RCL2 4CLB TXU 0 Z3CLOCKANUM(1) 4D62 BCS PTERR 4DKL RCL1 4F5= ORX 6 GSIGN [SET BO OF RETURN ADDR AS A FLAG. 4FJW NGNC 2 1 4G4G RCL2 LDN 2 2 [SET LOOP COUNT=2 FOR XX.XX;3 ELSE 4GJ6 ERX 6 GSIGN [FLIP B0. NOW SET IF SHORT FORMAT 4H3Q LDCT 7 #400 4HHB BRN RCL3 4J32 RCL4 LDCH 5 APARA(3) 4JGL SBN 5 #36 4K2= BNZ 5 PTERR [ERROR IF SEPERATOR NOT FULL STOP 4KFW BCHX 3 £ 4K^G RCL3 LDN 5 2 [NUMBER OF CHARS TO CDB 4LF6 LDN 0 0 4LYQ LDN 1 0 4MDB RCL5 CDB 0 APARA(3) 4MY2 BCS PTERR 4NCL BCHX 3 £ 4NX= BCT 5 RCL5 4PBW LDN 5 60 4PWG LDXC 7 7 4QB6 BCC RCL6 [J IF NOT FIRST NUMBER PAIR 4QTQ LDN 5 24 4R*B RCL6 TXL 1 5 4RT2 BCC PTERR [NUMBER PAIR>PERMITTED MAX. 4S#L LDN 5 60 4SS= RCL7 MPY 7 5 4T?W LDX 7 1 4TRG ADX 7 0 [ACCUMULATE TOTAL SO FAR 4W?6 BCT 2 RCL4 [REPEAT CONVERSION FOR NEXT PAIR 4WQQ LDN 2 1 4X=B LDN 1 0 4XQ2 LDXC 6 6 4Y9L BCS RCL7 [J IF SHORT FORM TO MULT BY 60 4YP= EXIT 6 0 4^8W # 4^NG # 5286 RDATEMACRO 52MQ # THIS S/R CONVERTS A DATE GIVEN IN XX/XX/XX FORMAT INTO A BINARY NO.OF 537B # SINCE 1900 53M2 # 546L SBX 6 FX1 54L= CALL 5 RPARAPASS 555W CHADCON PTERR 55KG LDX 7 EXEC1(2) [RESULT IS PASSED ACROSS IN EXEC1 5656 ADX 6 FX1 56JQ EXIT 6 0 574B # 57J2 RTIMEUNIT 583L # THIS S/R CONVERTS N UNITS OF TIME INTO BINARY SECS. 58H= # 592W SBX 6 FX1 59GG CALL 5 PARA [GET NEXT PARAMETER 5=26 RTU0 PARSPLIT 5 5=FQ BNG 5 RTU1 5=^B BNZ 5 RTU5 [J IF ERROR 5?F2 RTU1 LDX 7 ACOMMUNE1(2) [BINARY NO. 5?YL BZE 5 RTU3 [J IF NO LETTERS -SECS. ASSUMED 5#D= TXU 5 SEC(1) 5#XW BCC RTU3 [J IF SECS 5*CG TXU 5 MIN(1) 5*X6 BCC RTU4 [J IF MINS 5BBQ TXU 5 ZHR(1) 5BWB BCS RTU5 [J IF NOT RECOGNISED 5CB2 LDN 0 3600 5CTL RTU2 MPY 7 0 [RESULT IN X0 5D*= LDX 7 0 5DSW RTU3 ADX 6 FX1 5F#G EXIT 6 0 5FS6 RTU4 LDN 0 60 5G?Q BRN RTU2 5GRB RTU5 ADX 6 FX1 5H?2 EXIT 6 1 5HQL # 5J== PTUER BNG 5 XCOM [J IF LETTER STRING UNRECOGNISED 5JPW SBN 5 1 [J IF NULL 5K9G BZE 5 PNULL [J IF NULL 5KP6 SBN 5 1 5L8Q BZE 5 PABS [J IF PARAM MISSING 5LNB BRN XEROP 5M82 PCLOCK 5MML CALL 6 RCLOCK 5N7= BRN PLOAD 5NLW PDATELOAD 5P6G CALL 6 RDATEMACRO 5PL6 BRN PLOAD 5Q5Q PTSN 5QKB CALL 5 RPARAPASS [X3->CUNI HOLDING MTNAME 5R52 DOWN JDTWO,2 [ANALYSE TSN DETAILS 5RJL BRN XMTER [ERROR FROM MT DESC 5S4= BRN XEROP [MESSAGE OUTPUT ALREADY 5SHW TSN9 MFREE FILE,FABSNB 5T3G LDX 7 ACOMMUNE1(2) 5TH6 BRN PLOAD 5W2Q # 5WGB PINTEGER 5X22 # THIS ROUTINE ACCEPTS NUMBERS,SIGNED OR UNSIGNED,SIMPLE EXPRESSIONS,ETC 5XFL # SPECIFIED BY CHNUMCON 4.8.2.5 5X^= # 5YDW CALL 5 RPARAPASS 5YYG CHNUMCON 1 [NUMBER CONVERSION ROUTINE,WITH 5^D6 TESTREP CHNUMERR,PTERR 5^XQ MHUNTW 3,CPAR,GNUMCON 62CB LDX 7 A1+1(3) [A1 HOLDS THE NUMBER OF EXPRESSIONS C 62F# ...[ B7270 CORRECTION 06.08.82 62H= ...[ ROUND UP MAXSIZE DATA 62K8 ... JBC PLOAD,2,TMAXSIZE 62M6 ... ADN 7 PROGRND-1 62P4 ... ANDX 7 PROGRNDN(1) 62R2 ... BXL 7 MAXSIZE(1),PLOAD 62SY ... LDX 7 MAXSIZE(1) 62X2 BRN PLOAD [AS BLOCK WAS PARAPASSED THERE CAN 63BL [BE ONLY ONE EXPRESSION. 63W= POCTAL 64*W # THIS ROUTINE ACCEPTS A SINGLE LENGTH NO. OF 64TG # EXPEXTED TO BE OCTAL AND PRECEDED BY A # 65*6 CALL 5 RPARAPASS 65SQ STO 3 GEN0 [CONVERTSION ROUTINE 66#B LDX 2 3 66S2 LDEX 3 ANUM(2) [NO OF CHARS 67?L LDCH 1 APARA(2) 67R= SBN 1 #23 [FIRST CHAR MUST BE # 68=W BNZ 1 PTERR [ELSE ERROR 68QG SBN 3 2 69=6 TXL 3 EIGHT [NO MORE THAN 8 FIG NO ALLOWED 69PQ BCC PTERR [ELSE ERROR 6=9B ADN 3 1 6=P2 LDN 0 0 6?8L XMCH1 6?N= BCHX 2 £ [CONVERT TO BINARY 6#7W LDCH 1 APARA(2) 6#MG TXL 1 EIGHT 6*76 BCC PTERR 6*LQ SLL 0 3 6B6B ORX 0 1 6BL2 BCT 3 XMCH1 6C5L LDX 2 FX2 6CK= STO 0 ACOMMUNE1(2) 6D4W LDX 1 FX1 6DJG LDX 3 GEN0 6F46 LDX 7 ACOMMUNE1(2) [SAVE CONVERTED NO. 6FHQ BRN PLOAD 6G3B # 6GH2 # 6H2L # 6HG= PDEADLINE 6H^W # THIS S/R PROVIDES THE FACILITY OF LOADING THREE PARAMETERS INTO THREE 6JFG # CONSECUTIVE WORDS IN THE USERS ENTRY IN WJL.THE REQUIRED FORMAT FOR TH 6J^6 # 1ST PARAM: DATE - DD/MM/YY *OPTIONAL* FORMAT SAME AS FACILITY 3 6KDQ # 2ND (1ST) PARAM: TIME - 24HR-CLOCK: HH.MM SAME AS FAC 2 6KYB # 3RD (2ND) PARAM: EST. RUN TIME: DIGITSTRING & UNITS CHARSTRING = FAC5. 6LD2 # 6LXL JBS PTERR,2,SINGLE [J IF SINGLE PARAM. 6MC= PARANUMB 7 [ESTABLISH THE NO.OF PARAMETERS-MAX=4 6MWW JBC PD0,2,TFORMAT [J IF 1ST FORMAT 6NBG ADN 7 1 6NW6 PD0 SBN 7 3 [1ST PARAMETER=8.2ND(OPTIONAL)IS'DATE 6P*Q BZE 7 NODATE [3RD IS 'CLOCK'.4TH IS 'TIME'. 6PTB CALL 6 RDATEMACRO 6Q*2 MFREE CPB,CUNI 6QSL NODATE 6R#= CALL 6 STOREX [STORE CONVERTED DATE OR ZERO 6RRW CALL 6 RCLOCK [2ND PARAMETER. 6S?G MFREE CPB,CUNI 6SR6 CALL 6 STOREX [STORE CONVERTED CLOCKTIME 6T=Q CALL 6 RTIMEUNIT [LAST PARAMETER. 6TQB BRN PLOAD 6W=2 BRN PTUER [J TO PTIMEUNIT'S ERROR ROUTINE. 6WPL [X3->ADATA/CSTORE. 6X9= # 6XNW # 6Y8G PSTRING [FACILITY 9 6YN6 # THIS ROUTINE PASSES OVER A CHAR STRING - INCLUDING SPACES, HAVING REMO 6^7Q # ONE LAYER OF PARENTHESES OR QUOTES - INTO AREA DEFINED BY :SYSTEM.JOBL 6^MB # FACILITIES TABLE. THE STRING IS EITHER TRUNCATED OR SPACE-FILLED AT TH 7272 # AS APPROPRIATE, IF NOT AN EXACT FIT. FORMS LIKE A(B) ARE NOT ALLOWED 72LL # 736= CALL 5 RSPARAPASS [GET NEXT PARAMETER 73KW SRL 0 12 745G SBN 0 2 74K6 BNG 0 STRINGREADY 754Q BNZ 0 PTERR 75JB JBS STRINGREADY,2,TFORMAT [J IF 2ND FORMAT 7642 LDN 1 2 76HL SPARANXT ,0,1 773= STRINGREADY 77GW MHUNT 3,CPB,CUNI 782G CALL 1 SCSTORE [SET X2->ADATA/CSTORE 78G6 LDX 0 ANUM(3) 78^Q SLL 0 22 79FB SMO A1+1(2) 79^2 ORS 0 0(2) [STORE CHAR. PTR. IN REC.HEDR. 7=DL LDX 7 ANUM(3) 7=Y= ANDN 7 #7777 7?CW ADN 7 3 7?XG SRL 7 2 7#C6 CALL 6 STOREN [STORE DATA IN CSTORE 7#WQ BRN RFIN 7*BB XK3 7*W2 STARTTIME 7B*L # THIS A SPECIAL ROUTINE TO EMULATE THE 7BT= # STARTTIME MACRO 7C#W CALL 5 PARA [GET NEXT PARAM. 7CSG LDX 7 ANUM(3) 7D#6 BZE 7 STTI2 7DRQ BNG 7 PTERR 7F?B CALL 6 RCL0 [CONVERT TIME 7FR2 LDX 2 FX2 7G=L STTI2 7GQ= STO 7 AWORK2(2) [KEEP THE TIME 7H9W LDX 7 EDATE [TODAY'S DATE 7HPG JBS STDTE,2,SINGLE 7J96 MFREE CPB,CUNI 7JNQ CALL 5 PARA [GET NEXT PARAM. 7K8B NGX 0 ANUM(3) 7KN2 BPZ 0 STDTE 7L7L CHADCON PTERR [CONVERT DATE 7LM= LDX 7 ACOMMUNE7(2) [DATE 7M6W # 7MLG STDTE 7N66 CALL 6 STOREX [STORE DATE 7NKQ LDX 7 AWORK2(2) 7P5B PLOAD CALL 6 STOREX [STORE TIME ALSO USED BY JD NO ROUTI 7PK2 RFIN 7Q4L MHUNT 3,ADATA,CSTORE 7QJ= LDX 0 A1(3) 7R3W SBX 0 A1+1(3) 7RHG BXGE 0 TOOSMALL(1),RFIN6 [J IF SOME JD DATA 7S36 SBS 0 A1(3) [RESET PTR->NEXT FREE WORD 7SGQ BRN RFIN8 7T2B RFIN6 BXGE 0 TOOBIG(1),TOOMUCH 7TG2 SMO A1+1(3) 7T^L DSA 0 0(3) [STORE WORD COUNT 7WF= SMO A1+1(3) 7WYW LDX 0 1(3) 7XDG BPZ 0 RFIN7 [J IF NOT FIXED RESOURCE 7XY6 ANDN 0 #4000 7YCQ BNZ 0 RFIN7 [J IF COUNT SET 7YXB JMBS NOCOUNT,2,TMINUS,TPLUS [ERROR IF SIGNED 7^C2 RFIN7 LDX 0 A1(3) 7^WL STO 0 A1+1(3) [PTR->NEXT RECORD 82B= RFIN8 LDN 7 0 82TW JBC RFIN81,2,STARTCOM [J IF JOBDATA PARAM 83*G LDN 7 3 83T6 RFIN81 84#Q PARAFREE 7 84SB JBS NEXT0,2,TFORMAT [J IF 2ND JD FORMAT 85#2 RFIN9 85RL HUNTW 3,ADATA,CSTORE 86?= BNG 3 THENDNEAR [J IF NO JOB DATA SUPPLIED 86QW MFREE CPB,CUNI 87=G ACROSS JDWRITE,1 [UPDATE ENTRY IN JOBLIST 87Q6 # 889Q # RETURN LABEL TO JOBDATA SEGMENT 88PB NEXT0 8992 ACROSS JOBDATA,10 89NL # 8=8= # ERROR REPORTING 8=MW # 8?7G # 8?M6 PNULL LDX 7 YER2(1) 8#6Q BRN RERROR 8#LB PABS LDX 7 YER3(1) 8*62 BRN RERROR 8*KL PTERR LDX 1 FX1 8B5= LDX 7 YER4(1) 8BJW BRN RERROR 8C4G XCOM LDX 7 YER5(1) 8CJ6 BRN RERROR 8D3Q TOOMUCH 8DHB LDX 7 YER8(1) 8F32 BRN RERROR 8FGL XMTER LDX 7 YER9(1) 8G2= BRN RERROR 8GFW NOCOUNT 8G^G LDX 7 YER10(1) 8HF6 BRN RERROR 8HYQ XEROP 8JDB LDX 7 GSIGN [ERROR ALREADY O/P 8JY2 XK2 8KCL RERROR 8KX= NGN 6 1 8LBW RERROR1 8LWG LDX 2 FX2 8MB6 JBS RERRORUP,2,STARTCOM [J IF JOBDATA PARAM. 8MTQ BNG 7 THEND 8N*B COMERRX 7,6 8NT2 THENDNEAR 8P#L LDX 2 FX2 8PS= JBC THEND,2,STARTCOM 8Q?W MFREE CPB,CUNI 8QRG UPPLUS 1 8R?6 THEND ENDCOM 8RQQ RERRORUP 8S=B BNG 7 RERRORUP5 [J IF ERROR ALREADY O/P 8SQ2 ERRORX 7,6 8T9L LDX 7 GSIGN [ERROR ALREADY O/P IND. 8TP= RERRORUP5 8W8W MFREE CPB,CUNI 8WNG STO 7 ACOMMUNE1(2) 8X86 UP 8XMQ XBREAK 8Y7B COMBRKIN 8YM2 #END ^^^^ ...076230150006