[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]
MISOSYS EDAS-4.3 04/11/99 00:18:23 DO - LS-DOS 6.2 Page 00001
00001 ;LBDO/ASM - Library 'DO' command
00003 ;
00C0 00004 JFCB$ EQU 0C0H ;Low core EQU*
00005 ;
00006 ;
0000 00007 SMALL EQU 0
000D 00008 CR EQU 13
0000 00009 *GET BUILDVER/ASM:3
00010 ;
00011 ; Buildver/asm is a bit of a kludge since not all utilities can load
00012 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00013 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00014 ; for programs that can use that.
00015 ;
FFFF 00016 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00017 ; These switches activate patches made since the 1B release.
00018 ; It is important that all earlier patches be enabled when a higher
00019 ; patch is enabled.
00020 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00021 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00022 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00023 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00024 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00025 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00026 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00027 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00028 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00029 ;
00030 ;End of BUILDVER/ASM
0000 00031 *GET SVCMAC:3 ;SVC Macro equivalents
00032 ;SVCMAC/ASM - LS-DOS Version VI
00033 *LIST OFF
00425 *LIST ON
00427 ;
2400 00428 ORG 2400H
00429 ;
2400 00430 DO EQU $
00431 ;
00432 ; Note: The first 80 bytes (until PARSINP) are
00433 ; Used as a line buffer during processing.
00434 ;
2400 00435 JCLBUF2 EQU $
2400 ED738229 00436 LD (SPSAV+1),SP ;Save stack pointer
00437 ;
00438 IF SMALL
00439 JR NOCPLS ;No compile if Small
00440 ENDIF
2404 228024 00441 LD (INBUF+1),HL ;Save start of command
00442 ;
00443 *LIST OFF
00445 *LIST ON
2407 00446 @@FLAGS ;Get flag table pointer
2407+3E65 00447 LD A,101
2409+EF 00448 RST 40
240A 7E 00449 LD A,(HL)
240B FE2A 00450 CP '*' ;Execute last DO file?
240D CAFE24 00451 JP Z,NOCPL2
2410 FE3D 00452 CP '=' ;Execute without compile?
2412 CAEA24 00453 JP Z,NOCPL
2415 FE24 00454 CP '$' ;Compile only?
2417 200A 00455 JR NZ,GETSPEC
2419 32C624 00456 LD (NOEXEC?+1),A
241C 23 00457 INC HL
241D 7E 00458 LD A,(HL)
241E FE20 00459 CP ' ' ;Bypass space separator
2420 2001 00460 JR NZ,GETSPEC ; if present
2422 23 00461 INC HL
2423 118C29 00462 GETSPEC LD DE,DOFCB ;Get DO filespec
2426 00463 @@FSPEC
2426+3E4E 00464 LD A,78
2428+EF 00465 RST 40
2429 C25129 00466 JP NZ,SPCREQ ;Go if bad/missing filespec
242C E5 00467 PUSH HL ;Save INBUF$ pointer
00468 IF @BLD631
242D CD8529 00469 CALL DOFEXT ;<631>Default ext to "/JCL"
00470 ELSE
00471 LD HL,SYSJCL+7 ;Default ext to "/JCL"
00472 @@FEXT
00473 ENDIF
2430 21002C 00474 LD HL,INPBUF ;Open DO file
2433 45 00475 LD B,L ;LRL=256
2434 FDCB12C6 00476 SET 0,(IY+'S'-'A') ;Inhibit file open bit
2438 00477 @@OPEN
2438+3E3B 00478 LD A,59
243A+EF 00479 RST 40
243B C24629 00480 JP NZ,IOERR ;Jump on open error
00481 IF @BLD631
243E 0EFF 00482 LD C,0FFH ;<631>
2440 0C 00483 L2440: INC C ;<631>
2441 79 00484 LD A,C ;<631>
2442 FE08 00485 CP 08H ;<631>
2444 D26529 00486 JP NC,DSKFUL ;<631>
2447 00487 @@CKDRV ;<631>
2447+3E21 00488 LD A,33
2449+EF 00489 RST 40
244A 20F4 00490 JR NZ,L2440 ;<631>
244C 38F2 00491 JR C,L2440 ;<631>
244E 79 00492 LD A,C ;<631>
244F C630 00493 ADD A,'0' ;<631>
00494 IF @BLD631G
2451 CDAC2A 00495 CALL P631G1 ;<631G>
00496 ELSE
00497 LD (DRVNUM),A ;<631>Set drive number in filespec
00498 ENDIF
00499 ENDIF
2454 CD0325 00500 CALL MOVFCB ;Move SYSTEM/JCL into FCB
2457 11C000 00501 LD DE,JFCB$ ;Init FCB pointer
245A 21002D 00502 LD HL,OUTBUF
245D 00503 @@INIT
245D+3E3A 00504 LD A,58
245F+EF 00505 RST 40
2460 C26529 00506 JP NZ,DSKFUL ;Jump on error
2463 E1 00507 POP HL ;Rcvr pointer to INBUF$
00508 ;
00509 ; Routine to parse a command line
00510 ;
2464 7E 00511 PARSINP LD A,(HL) ;P/u line char
2465 FE0D 00512 CP CR ;End of line?
2467 CA5625 00513 JP Z,TSTLBL
246A 23 00514 INC HL ;Bump pointer
246B CD3629 00515 CALL CKSPCOM ;Ignore spaces & commas
246E 28F4 00516 JR Z,PARSINP
2470 FE28 00517 CP '(' ;Beginning of parms?
2472 CA0F25 00518 JP Z,PARAM
2475 FE3B 00519 CP ';' ;Line continuation?
2477 C26929 00520 JP NZ,PRMERR
247A 0E3F 00521 LD C,'?' ;Prompt for line continue
247C 00522 @@DSP
247C+3E02 00523 LD A,2
247E+EF 00524 RST 40
247F 210000 00525 INBUF LD HL,$-$ ;Input continuation line
2482 2D 00526 DEC L ;Backup to start
2483 2D 00527 DEC L
2484 01004F 00528 LD BC,79<8 ;Max 79 chars input
2487 00529 @@KEYIN
2487+3E09 00530 LD A,9
2489+EF 00531 RST 40
248A DA6929 00532 JP C,PRMERR ;Jump if break
248D 00533 @@LOGER ;Log the line
248D+3E0B 00534 LD A,11
248F+EF 00535 RST 40
2490 18D2 00536 JR PARSINP ;Go parse it
00537 ;
00538 ; Routine to move to higher level nest
00539 ;
2492 2ACC2A 00540 UNNEST LD HL,(NESTPTR) ;Shift the last nest's
2495 2B 00541 DEC HL ; FCB into FCB area
2496 11AB29 00542 LD DE,DOFCB+31
2499 012000 00543 LD BC,32
249C EDB8 00544 LDDR
249E 23 00545 INC HL
249F 22CC2A 00546 LD (NESTPTR),HL ;Reset current FCB ptr
24A2 118C29 00547 LD DE,DOFCB ;Reread last sector of
24A5 00548 @@RREAD ; nested FCB
24A5+3E45 00549 LD A,69
24A7+EF 00550 RST 40
00551 IF @BLD631
24A8 C8 00552 RET Z ;<631>
24A9 C34629 00553 NIOERR: JP IOERR ;<631>
00554 ELSE
00555 JP NZ,IOERR
00556 RET
00557 ENDIF
00558 ;
24AC 2ACC2A 00559 CKNEST LD HL,(NESTPTR) ;P/u current FCB pointer
24AF 11CE2A 00560 LD DE,NESTFCB ;Is it the first nest?
24B2 AF 00561 XOR A
24B3 ED52 00562 SBC HL,DE
24B5 2806 00563 JR Z,CPLFIN ;Jump if so & exit
24B7 CD9224 00564 CALL UNNEST ; processing
24BA C38C25 00565 JP CPLJCL
00566 ;
00567 ; Finished compilation - Close 'er up
00568 ;
24BD 11C000 00569 CPLFIN LD DE,JFCB$ ;Close SYSTEM/JCL file
24C0 00570 @@CLOSE
24C0+3E3C 00571 LD A,60
24C2+EF 00572 RST 40
00573 IF @BLD631
24C3 20E4 00574 JR NZ,NIOERR ;<631>
00575 ELSE
00576 JP NZ,IOERR
00577 ENDIF
24C5 3E00 00578 NOEXEC? LD A,0 ;Set to non-zero on
24C7 B7 00579 OR A ; compile only
24C8 210000 00580 LD HL,0
24CB C0 00581 RET NZ ;Exit on compile only
00582 ENDIF
00583 *LIST ON
00584 ;
24CC 11C000 00585 CPLFIN1 LD DE,JFCB$ ;Point to SYSTEM/JCL FCB
24CF 210000 00586 LD HL,0 ;Correct bufptr later
24D2 45 00587 LD B,L ;LRL=256
24D3 FDCB12C6 00588 SET 0,(IY+'S'-'A') ;Inhibit file open bit
24D7 00589 @@OPEN ;Open it up
24D7+3E3B 00590 LD A,59
24D9+EF 00591 RST 40
00592 IF @BLD631
24DA 20CD 00593 JR NZ,NIOERR ;<631>Jump on error
00594 ELSE
00595 JP NZ,IOERR ;Jump on error
00596 ENDIF
24DC ED4BC600 00597 LD BC,(JFCB$+6) ;Get SBUFF$
24E0 00598 @@DIRRD
24E0+3E57 00599 LD A,87
24E2+EF 00600 RST 40
24E3 7C 00601 LD A,H ;Stuff high order to
24E4 32C400 00602 LD (JFCB$+4),A ; use for JFCB$ buffer
24E7 3E9D 00603 LD A,9DH ;Call SYS11, entry 1
24E9 EF 00604 RST 28H
00605 ;
00606 ; Process execution without compilation
00607 ;
24EA 23 00608 NOCPL INC HL
24EB 7E 00609 NOCPLS LD A,(HL) ;Bypass space separator
24EC FE20 00610 CP ' ' ; if present
24EE 28FA 00611 JR Z,NOCPL
24F0 11C000 00612 NOCPL1 LD DE,JFCB$ ;Fetch DO filespec
24F3 00613 @@FSPEC
24F3+3E4E 00614 LD A,78
24F5+EF 00615 RST 40
24F6 C25129 00616 JP NZ,SPCREQ ;Jump on error
00617 IF @BLD631
24F9 CD8529 00618 CALL DOFEXT ;<631>
00619 ELSE
00620 LD HL,SYSJCL+7 ;Default to /JCL
00621 @@FEXT
00622 ENDIF
24FC 18CE 00623 JR CPLFIN1 ;Go execute file
00624 ;
00625 *LIST OFF
00627 *LIST ON
24FE CD0325 00628 NOCPL2 CALL MOVFCB ;Execute SYSTEM/JCL
2501 18C9 00629 JR CPLFIN1 ; file
00630 ;
2503 21E029 00631 MOVFCB LD HL,SYSJCL ;Move SYSTEM/JCL into
2506 11C000 00632 LD DE,JFCB$ ; FCB area
00633 IF @BLD631
00634 DOLDIR: ;<631>
00635 ENDIF
2509 012000 00636 LD BC,32
250C EDB0 00637 LDIR
250E C9 00638 RET
00639 ;
00640 ; Found a parm entered
00641 ;
250F CDF027 00642 PARAM CALL PARSNAM ;Parse symbol -> current
2512 2014 00643 JR NZ,PARAM1 ;Jump if bad symbol
2514 F5 00644 PUSH AF ;Save separator char
2515 3E00 00645 FNDLBL LD A,0 ;Test if a label
2517 B7 00646 OR A ; was found
2518 2029 00647 JR NZ,MOVLBL
251A CDBA28 00648 CALL FINDSYM ;Search symbol table
251D CA6D29 00649 JP Z,MULDEF ;Multiply defined if in
2520 CD9D28 00650 CALL MOVNAME ;Add symbol to table
2523 F1 00651 POP AF ;Recover separator
2524 FE3D 00652 CP '=' ;Assignment?
2526 2811 00653 JR Z,PARAM2
2528 CD3629 00654 PARAM1 CALL CKSPCOM ;Ck space or comma
252B 28E2 00655 JR Z,PARAM
252D FE29 00656 CP ')' ;Exit parm scan on
252F CA6424 00657 JP Z,PARSINP ; closing paren
2532 FE0D 00658 CP CR ;Also accept closing CR
2534 2820 00659 JR Z,TSTLBL
2536 C36929 00660 JP PRMERR ;Else parm error
00661 ;
2539 CDFB27 00662 PARAM2 CALL PARSVAL ;Parse value into buf
253C F5 00663 PUSH AF ;Save separator char
253D CDAF28 00664 CALL MOVALUE ;Symbol value into table
2540 F1 00665 GETSEP POP AF ;Recover separator
2541 18E5 00666 JR PARAM1 ;Loop
00667 ;
2543 E5 00668 MOVLBL PUSH HL
2544 21AC29 00669 LD HL,CURSYM ;Pt to current sym buf
2547 11D529 00670 LD DE,LBLSAV ; & save label for
254A 010800 00671 LD BC,8 ; later testing
254D EDB0 00672 LDIR
254F AF 00673 XOR A ;Turn off "found label"
2550 321625 00674 LD (FNDLBL+1),A
2553 E1 00675 POP HL ;Rcvr line ptr
2554 18EA 00676 JR GETSEP ;Back for more
00677 ;
00678 ; Got to end of JCL command line
00679 ;
2556 3A5E28 00680 TSTLBL LD A,(GOTLBL+1) ;Was @LABEL a parm?
2559 B7 00681 OR A
255A 2830 00682 JR Z,CPLJCL ;If not, don't look
00683 ;
00684 ; Find the procedure block named @LABEL
00685 ;
255C CD6F26 00686 FINDLBL CALL RDJCL ;Read JCL line
255F 2811 00687 JR Z,GOTLIN ;Go if line read
2561 2ACC2A 00688 LD HL,(NESTPTR) ;See if nested
2564 11CE2A 00689 LD DE,NESTFCB ; in an Include file
2567 AF 00690 XOR A
2568 ED52 00691 SBC HL,DE
256A CA5D29 00692 JP Z,NOFIND ;If not, lable not found
256D CD9224 00693 CALL UNNEST ; else continue search
2570 18EA 00694 JR FINDLBL
00695 ;
2572 219E2B 00696 GOTLIN LD HL,JCLBUF1 ;Pt to start
2575 7E 00697 LD A,(HL) ;Is 1st char a label
2576 FE40 00698 CP '@' ; indicator?
2578 20E2 00699 JR NZ,FINDLBL ;Back for more if not
00700 ;
00701 ; Found a label - is it the one needed?
00702 ;
257A 23 00703 INC HL ;Pt to 1st char
257B EB 00704 EX DE,HL ;Ptr to DE
257C 21D529 00705 LD HL,LBLSAV
257F 010808 00706 LD BC,808H ;Symbol & field len =8
2582 CDE628 00707 CALL FNDPRM ;A match?
2585 20D5 00708 JR NZ,FINDLBL ;No match? look for next
2587 1803 00709 JR CPLJCL ; else you're the one
00710 ;
2589 CDA026 00711 CONDCPL CALL TSTCOND
258C CD6F26 00712 CPLJCL CALL RDJCL ;Read line from JCL file
258F C2AC24 00713 JP NZ,CKNEST ;Exit on end of file
2592 219E2B 00714 LD HL,JCLBUF1 ;Parse the line just read
2595 110024 00715 LD DE,JCLBUF2
2598 7E 00716 LD A,(HL)
2599 23 00717 INC HL
259A FE40 00718 CP '@' ;End procedure if found
259C CAAC24 00719 JP Z,CKNEST ; another label
259F FE2F 00720 CP '/' ;Slash?
25A1 2004 00721 JR NZ,CPLJCL1
25A3 BE 00722 CP (HL) ;Double slash?
25A4 CA4126 00723 JP Z,MACRO ;Jump on double slash
00724 CPLJCL1
00725 ;
00726 ; Modification for HEX parsing
00727 ;
25A7 FE23 00728 CP '#' ;Substitution?
25A9 2825 00729 JR Z,CPLJCL4
25AB FE25 00730 CP '%' ;Hex value?
25AD 2017 00731 JR NZ,CPLJCL2 ;Back to take char if not
25AF CDB425 00732 CALL CPLJCL7 ;Go test double %
25B2 1818 00733 JR CPLJCL3
25B4 BE 00734 CPLJCL7 CP (HL) ;Double %?
25B5 2821 00735 JR Z,CPLJCL6
25B7 CDDC25 00736 CALL CVRTHEX ;Convert digit
25BA 23 00737 INC HL ;Bump to next char
25BB 07 00738 RLCA
25BC 07 00739 RLCA
25BD 07 00740 RLCA
25BE 07 00741 RLCA ;Rotate into left nybble
25BF 4F 00742 LD C,A ;Save for now
25C0 CDDC25 00743 CALL CVRTHEX ;Convert 2nd digit
25C3 B1 00744 OR C ;Merge left nybble
25C4 1812 00745 JR CPLJCL6
25C6 12 00746 CPLJCL2 LD (DE),A ;Nothing special, xfer
25C7 13 00747 INC DE
25C8 FE0D 00748 CP CR
25CA 28BD 00749 JR Z,CONDCPL ;Exit on end of line
25CC 7E 00750 CPLJCL3 LD A,(HL) ;Grab next input char
25CD 23 00751 INC HL
25CE 18D7 00752 JR CPLJCL1 ; & loop
25D0 CDD525 00753 CPLJCL4 CALL CPLJCL5 ;Ck on double '#'
25D3 18F7 00754 JR CPLJCL3 ;Substitute if not ##
25D5 BE 00755 CPLJCL5 CP (HL) ;Double #?
25D6 2015 00756 JR NZ,SUBSYM ;Jump to substitute if
25D8 23 00757 CPLJCL6 INC HL ; only single #
25D9 12 00758 LD (DE),A ; else xfer the char
25DA 13 00759 INC DE
25DB C9 00760 RET
00761 ;
25DC 7E 00762 CVRTHEX LD A,(HL) ;P/u the digit
25DD D630 00763 SUB 30H ;Start conversion
25DF 380A 00764 JR C,CVRTHE1 ;Error if < 0
25E1 FE0A 00765 CP 10
25E3 D8 00766 RET C ;Go if 0-9
25E4 CBAF 00767 RES 5,A ;In case l/c
25E6 D607 00768 SUB 7 ;Adjust A-F -> 10-15
25E8 FE10 00769 CP 16
25EA D8 00770 RET C ;Go if 10-15
25EB 183F 00771 CVRTHE1 JR BADHDR
00772 ;
00773 ; Symbol substitution routine
00774 ;
25ED E5 00775 SUBSYM PUSH HL
25EE D5 00776 PUSH DE
25EF CDF027 00777 CALL PARSNAM ;Parse symbol
25F2 FE23 00778 CP '#' ;Must have closing #
25F4 2036 00779 JR NZ,BADHDR ;Bad JCL format if not
25F6 E3 00780 EX (SP),HL ;Put new posn on stack
25F7 E5 00781 PUSH HL ; and get HL=start posn
25F8 CDBA28 00782 CALL FINDSYM ;Get symbol value
25FB 200F 00783 JR NZ,SUBSYM1 ;Bypass if not in table
25FD 1A 00784 LD A,(DE) ;Get symbol length
25FE B7 00785 OR A
25FF 280B 00786 JR Z,SUBSYM1 ;Bypass if zero length
2601 0600 00787 LD B,0
2603 4F 00788 LD C,A
2604 13 00789 INC DE ;Point to 1st symbol char
2605 E1 00790 POP HL ;Rcvr where we need to
2606 EB 00791 EX DE,HL ; substitute then move
2607 EDB0 00792 LDIR ; symbol value into pos
2609 E1 00793 POP HL
260A F1 00794 POP AF
260B C9 00795 RET
00796 ;
260C D1 00797 SUBSYM1 POP DE ;Symbol not in table, so
260D F1 00798 POP AF ; leave as is in the DO
260E E1 00799 POP HL ; file.
260F 3E23 00800 LD A,'#' ;Starting #
2611 12 00801 SUBSYM2 LD (DE),A
2612 13 00802 INC DE ;Inc buffer
2613 7E 00803 LD A,(HL) ;Get a char from line
2614 23 00804 INC HL
2615 FE0D 00805 CP CR ;If a CR before closing #
2617 2813 00806 JR Z,BADHDR ; abort
2619 FE23 00807 CP '#' ;End of substitution?
261B 20F4 00808 JR NZ,SUBSYM2 ;Get more if not
261D 12 00809 LD (DE),A
261E 13 00810 INC DE
261F C9 00811 RET
00812 ;
00813 ; Check if conditional is at top level
00814 ;
2620 ED5B6E2B 00815 CKCOND LD DE,(CONDPTR) ;P/u conditional pointer
2624 21702B 00816 LD HL,CONDFLG ;Test if still on 1st one
2627 AF 00817 XOR A
2628 ED52 00818 SBC HL,DE
262A EB 00819 EX DE,HL ;Pointer back to HL
262B C0 00820 RET NZ ;Ok if nested else error
00821 ;
00822 ; Output invalid JCL format message
00823 ;
262C 11952B 00824 BADHDR LD DE,BADHDR$+5 ;Show bad JCL line found
262F 2ADE29 00825 LD HL,(LINENO) ;Put decimal line #
2632 00826 @@HEXDEC ; into message
2632+3E61 00827 LD A,97
2634+EF 00828 RST 40
2635 21902B 00829 LD HL,BADHDR$ ;Display bad line #
2638 00830 @@LOGOT
00831 IFEQ 00H,1
00832 LD HL,
00833 ENDIF
2638+3E0C 00834 LD A,12
263A+EF 00835 RST 40
263B 218C2A 00836 BADH1 LD HL,BADJCL$ ; and abort message
263E C37029 00837 JP EXTERR
00838 ;
00839 ; Compile "//" line
00840 ;
2641 23 00841 MACRO INC HL
2642 CDF027 00842 CALL PARSNAM ;Get symbol name
2645 2015 00843 JR NZ,MACRO2 ;Go if not JCL macro
2647 CDCB28 00844 CALL CK4COND ;Ck for IF, ELSE, END
264A D5 00845 PUSH DE ;Stack the routine entry
264B C8 00846 RET Z ; & branch if found
264C D1 00847 POP DE ; else remove RET &...
00848 ;
00849 ; Test the conditional logic state
00850 ;
264D ED5B6E2B 00851 LD DE,(CONDPTR) ;P/u conditional pointer
2651 1A 00852 LD A,(DE) ; & conditional state
2652 B7 00853 OR A
2653 C28C25 00854 JP NZ,CPLJCL ;Jump if logic FALSE
2656 CDD428 00855 CALL CK4ASSN ;Test for SET, RESET,
00856 ; ASSIGN, INCLUDE, QUIT
2659 D5 00857 PUSH DE ;Stack the routine entry
265A C8 00858 RET Z ; & branch if found
265B D1 00859 POP DE
265C 119E2B 00860 MACRO2 LD DE,JCLBUF1 ;Point to where we left
265F AF 00861 XOR A ; off and continue to
2660 ED52 00862 SBC HL,DE ; parse the input line
2662 44 00863 LD B,H ; from the JCL file
2663 4D 00864 LD C,L
2664 219E2B 00865 LD HL,JCLBUF1
2667 110024 00866 LD DE,JCLBUF2
266A EDB0 00867 LDIR
266C C3CC25 00868 JP CPLJCL3
00869 ;
00870 ; Read a line from the JCL file
00871 ;
266F 2ADE29 00872 RDJCL LD HL,(LINENO) ;Bump line counter
2672 23 00873 INC HL
2673 22DE29 00874 LD (LINENO),HL
2676 219E2B 00875 LD HL,JCLBUF1 ;Point to line buffer
2679 118C29 00876 LD DE,DOFCB ;Point to FCB
267C 0650 00877 LD B,80 ;Permit only 80 chars
267E 00878 RDJCL1 @@GET ;Get a char
267E+3E03 00879 LD A,3
2680+EF 00880 RST 40
2681 2014 00881 JR NZ,RDJCL2 ;Jump on error
2683 B7 00882 OR A
2684 2816 00883 JR Z,RDJCL3 ;Bypass on null byte
2686 77 00884 LD (HL),A ;Xfer byte to line buf
2687 23 00885 INC HL
2688 FE0D 00886 CP CR ;End of line?
268A C8 00887 RET Z
268B 10F1 00888 DJNZ RDJCL1 ;Loop if not
00889 ;
00890 ; If falls through, line too long
00891 ;
268D 360D 00892 LD (HL),CR ;Stuff CR & provide
268F 21002A 00893 LD HL,LINLNG$ ; error log message
2692 223C26 00894 LD (BADH1+1),HL
2695 1895 00895 JR BADHDR
00896 ;
2697 FE1C 00897 RDJCL2 CP 1CH ;EOF?
2699 C24629 00898 JP NZ,IOERR ;Jump on any other error
269C 3E1C 00899 RDJCL3 LD A,1CH
269E B7 00900 OR A
269F C9 00901 RET
00902 ;
00903 ; Act on JCL line if conditional state = TRUE
00904 ;
26A0 2A6E2B 00905 TSTCOND LD HL,(CONDPTR) ;Grab conditional pointer
26A3 7E 00906 LD A,(HL) ;Grab conditional state
26A4 B7 00907 OR A
26A5 C0 00908 RET NZ ;Return if logic FALSE
26A6 210024 00909 LD HL,JCLBUF2 ;Point to processed line
26A9 11C000 00910 LD DE,JFCB$ ;SYSTEM/JCL FCB
26AC 7E 00911 LD A,(HL) ;Ck on double /
26AD FE2F 00912 CP '/'
26AF 2010 00913 JR NZ,WRCPLD ;Done if not /
26B1 23 00914 INC HL
26B2 BE 00915 CP (HL) ;Check for double /
26B3 2B 00916 DEC HL
26B4 200B 00917 JR NZ,WRCPLD ;Jump if not //
26B6 3A0224 00918 LD A,(JCLBUF2+2) ;Ck on comment
26B9 FE2E 00919 CP '.' ;//. ?
26BB 2004 00920 JR NZ,WRCPLD ;Bypass if not comment
26BD 00921 @@DSPLY ;Else display the comment
00922 IFEQ 00H,1
00923 LD HL,
00924 ENDIF
26BD+3E0A 00925 LD A,10
26BF+EF 00926 RST 40
26C0 C9 00927 RET
00928 ;
00929 ; Write compiled line to SYSTEM/JCL
00930 ;
26C1 4E 00931 WRCPLD LD C,(HL) ;P/u a char
26C2 00932 @@PUT ;Put it out
26C2+3E04 00933 LD A,4
26C4+EF 00934 RST 40
26C5 C24629 00935 JP NZ,IOERR ;Jump on error
26C8 7E 00936 LD A,(HL) ;Grab again to test
26C9 23 00937 INC HL ;Bump pointer
26CA FE0D 00938 CP CR ;End of line?
26CC 20F3 00939 JR NZ,WRCPLD ;Loop if not
26CE C9 00940 RET
00941 ;
00942 ; Parameter tables
00943 ;
26CF 49 00944 CONDTBL DB 'IF '
46 20 20 20
26D4 1827 00945 DW IF01
26D6 45 00946 DB 'ELSE '
4C 53 45 20
26DB 4127 00947 DW ELSE1
26DD 45 00948 DB 'END '
4E 44 20 20
26E2 4C27 00949 DW END1
26E4 00 00950 NOP
26E5 53 00951 ASSNTBL DB 'SET '
45 54 20 20 20 20 20
26ED 7B27 00952 DW SET1
26EF 52 00953 DB 'RESET '
45 53 45 54 20 20 20
26F7 8A27 00954 DW RESET1
26F9 41 00955 DB 'ASSIGN '
53 53 49 47 4E 20 20
2701 9C27 00956 DW ASSIGN
2703 49 00957 DB 'INCLUDE '
4E 43 4C 55 44 45 20
270B B727 00958 DW INCLUD
270D 51 00959 DB 'QUIT '
55 49 54 20 20 20 20
2715 EA27 00960 DW QUIT
2717 00 00961 NOP
00962 ;
00963 ; Process IF command
00964 ;
2718 CD5527 00965 IF01 CALL IF05 ;Parse expression
271B 2814 00966 JR Z,IF02 ;Z=true, NZ=false
271D FE0D 00967 CP CR ;False & end of line?
271F 2813 00968 JR Z,IF03
2721 FE2B 00969 CP '+' ;Logical OR?
2723 28F3 00970 JR Z,IF01
00971 ;
00972 ; Test for FALSE and logical AND (&)
00973 ;
2725 FE26 00974 CP '&' ;Separator AND?
2727 2055 00975 JR NZ,BADHDR0 ;Invalid format if not
2729 23 00976 IF01A INC HL ;Ignore rest of line
272A 7E 00977 LD A,(HL)
272B FE0D 00978 CP CR
272D 20FA 00979 JR NZ,IF01A
272F 1803 00980 JR IF03
2731 AF 00981 IF02 XOR A ;Logic = true
2732 1802 00982 JR IF04
2734 3EFF 00983 IF03 LD A,0FFH ;Logic = false
2736 2A6E2B 00984 IF04 LD HL,(CONDPTR) ;Get conditional pointer
2739 B6 00985 OR (HL) ;Set logic state
273A 23 00986 INC HL ;Bump pointer
273B 77 00987 LD (HL),A ;Stuff state result
273C 226E2B 00988 LD (CONDPTR),HL ;Save pointer
273F 1846 00989 JR GOJCL
00990 ;
00991 ; Process ELSE command
00992 ;
2741 CD2026 00993 ELSE1 CALL CKCOND ;Ck nest of conditional
2744 7E 00994 LD A,(HL) ;Flip state of flag based
2745 2F 00995 CPL ; on previous test
2746 2B 00996 DEC HL
2747 B6 00997 OR (HL) ;OR in previous state
2748 23 00998 INC HL
2749 77 00999 LD (HL),A ;Store new value
274A 183B 01000 JR GOJCL
01001 ;
01002 ; Process END command
01003 ;
274C CD2026 01004 END1 CALL CKCOND ;Ck nest level
274F 2B 01005 DEC HL ;Backup conditional one
2750 226E2B 01006 LD (CONDPTR),HL ; level & reset pointer
2753 1832 01007 JR GOJCL
01008 ;
01009 ; Parse conditional expression logic
01010 ;
2755 CD5F27 01011 IF05 CALL IF06 ;Get if symbol is true
2758 C0 01012 RET NZ ; or false & ret if false
2759 FE26 01013 CP '&' ;Logical AND separator?
275B 28F8 01014 JR Z,IF05 ;If TRUE AND -> ck next
275D AF 01015 XOR A ;True and not AND,
275E C9 01016 RET ; ret true
275F 7E 01017 IF06 LD A,(HL)
2760 FE2D 01018 CP '-' ;Logical NOT?
2762 200A 01019 JR NZ,IF08
2764 23 01020 INC HL ;Bypass '-'
2765 CD6E27 01021 CALL IF08 ;Grab symbol logic state
2768 2001 01022 JR NZ,IF07 ;Z=true, NZ=false
276A F6 01023 DB 0F6H ;Was true, not => false
276B AF 01024 IF07 XOR A ;Was false, not => true
276C 78 01025 LD A,B ;Rcvr separator
276D C9 01026 RET
276E CDF027 01027 IF08 CALL PARSNAM ;Get symbol name into buf
2771 C0 01028 RET NZ ;Ret if bad symbol
2772 F5 01029 PUSH AF
2773 E5 01030 PUSH HL
2774 CDBA28 01031 CALL FINDSYM ;Find symbol in table
2777 E1 01032 POP HL
2778 C1 01033 POP BC
2779 78 01034 LD A,B ;Put zero in A & use flag
277A C9 01035 RET ;From search
01036 ;
01037 ; Process SET command
01038 ;
277B CDF027 01039 SET1 CALL PARSNAM ;Parse symbol name
277E C22C26 01040 BADHDR0 JP NZ,BADHDR ;Jump if bad symbol
2781 CDBA28 01041 CALL FINDSYM ;Find in table
2784 C49D28 01042 CALL NZ,MOVNAME ;Move name into table
2787 C38C25 01043 GOJCL JP CPLJCL
01044 ;
01045 ; Process RESET command
01046 ;
278A CDF027 01047 RESET1 CALL PARSNAM ;Parse symbol name
278D 20EF 01048 JR NZ,BADHDR0
278F CDBA28 01049 CALL FINDSYM ;Find symbol in table
2792 20F3 01050 JR NZ,GOJCL ;No problem if not there
2794 21F8FF 01051 LD HL,-8 ;Point to start of name
2797 19 01052 ADD HL,DE ; & put in a blank
2798 3620 01053 LD (HL),' ' ; to remove symbol
279A 18EB 01054 JR GOJCL
01055 ;
01056 ; Process ASSIGN command
01057 ;
279C CDF027 01058 ASSIGN CALL PARSNAM ;Parse symbol name
279F 20DD 01059 JR NZ,BADHDR0 ;Jump on bad name
27A1 F5 01060 PUSH AF ;Save separator char
27A2 CDBA28 01061 CALL FINDSYM ;Find in table
27A5 C49D28 01062 CALL NZ,MOVNAME ;Add to table if not in
27A8 F1 01063 POP AF ;Recover separator
27A9 FE3D 01064 CP '=' ;Error if not =
27AB 20D1 01065 JR NZ,BADHDR0
27AD CDFB27 01066 CALL PARSVAL ;Parse value of symbol
27B0 20CC 01067 JR NZ,BADHDR0
27B2 CDAF28 01068 CALL MOVALUE ;Place value into table
27B5 18D0 01069 JR GOJCL
01070 ;
01071 ; Process INCLUDE command
01072 ;
27B7 E5 01073 INCLUD PUSH HL
27B8 ED5BCC2A 01074 LD DE,(NESTPTR) ;Point to next FCB save
27BC 216E2B 01075 LD HL,NESTEND ; area & check if room
27BF AF 01076 XOR A ; to store another FCB
27C0 ED52 01077 SBC HL,DE
27C2 CA5529 01078 JP Z,NESTS ;Error if 5 nests already
27C5 218C29 01079 LD HL,DOFCB ;Shift current FCB into
01080 IF @BLD631
27C8 CD0925 01081 CALL DOLDIR ;<631>INCLUDE FCB save area
01082 ELSE
01083 LD BC,32 ; INCLUDE FCB save area
01084 LDIR
01085 ENDIF
27CB ED53CC2A 01086 LD (NESTPTR),DE ;Update new nest pointer
27CF E1 01087 POP HL
27D0 118C29 01088 LD DE,DOFCB ;Point to FCB
27D3 01089 @@FSPEC ;Fetch included file
27D3+3E4E 01090 LD A,78
27D5+EF 01091 RST 40
27D6 20A6 01092 JR NZ,BADHDR0 ;Jump on error
01093 IF @BLD631
27D8 CD8529 01094 CALL DOFEXT ;<631>
01095 ELSE
01096 LD HL,SYSJCL+7 ;Default to /JCL
01097 @@FEXT
01098 ENDIF
27DB 21002C 01099 LD HL,INPBUF ;Open the included file
27DE 45 01100 LD B,L
27DF FDCB12C6 01101 SET 0,(IY+'S'-'A') ;Inhibit file open bit
27E3 01102 @@OPEN
27E3+3E3B 01103 LD A,59
27E5+EF 01104 RST 40
27E6 2096 01105 JR NZ,BADHDR0
27E8 189D 01106 JR GOJCL
01107 ;
01108 ; Process QUIT command
01109 ;
27EA 219E2B 01110 QUIT LD HL,JCLBUF1 ;Log the //QUIT command
27ED C37029 01111 JP EXTERR
01112 ;
01113 ; Parse symbol name
01114 ; A <= separator char
01115 ; Z = ok, NZ = bad symbol char
01116 ;
27F0 D5 01117 PARSNAM PUSH DE
27F1 0608 01118 LD B,8 ;8 chars max
27F3 11AC29 01119 LD DE,CURSYM ;Symbol buffer area
27F6 CD3728 01120 CALL PARSER ;Parse it
27F9 D1 01121 POP DE
27FA C9 01122 RET
01123 ;
01124 ; Parse a symbol value
01125 ;
27FB D5 01126 PARSVAL PUSH DE
27FC 0620 01127 LD B,32 ;32 chars max
27FE 11B529 01128 LD DE,VALBUF ;Value buffer
2801 CD1A28 01129 CALL XFRSTR ;Transfer from input
2804 F5 01130 PUSH AF
2805 E5 01131 PUSH HL
2806 EB 01132 EX DE,HL ;Calculate length of
2807 11B529 01133 LD DE,VALBUF ; the string
280A AF 01134 XOR A
280B ED52 01135 SBC HL,DE
280D 7D 01136 LD A,L
280E FE21 01137 CP 33
2810 D25929 01138 JP NC,TOOLNG ;Jump if > 32 chars
2813 32B429 01139 LD (STRLEN),A ;Stuff string length
2816 E1 01140 POP HL
2817 F1 01141 POP AF
2818 D1 01142 POP DE
2819 C9 01143 RET
01144 ;
01145 ; Transfer a string field
01146 ;
281A CD3728 01147 XFRSTR CALL PARSER ;Xfer max of 32 chars
281D CD3629 01148 XFRSTR1 CALL CKSPCOM ;Return on space
2820 C8 01149 RET Z ; or comma
2821 FE0D 01150 CP CR
2823 C8 01151 RET Z ;Ret on end of line
2824 FE3D 01152 CP '='
2826 C8 01153 RET Z ;Ret on =
2827 FE28 01154 CP '('
2829 C8 01155 RET Z ;Ret on left paren
282A FE29 01156 CP ')'
282C C8 01157 RET Z ;Ret on right paren
282D FE23 01158 CP '#'
282F 20E9 01159 JR NZ,XFRSTR ;Loop if not #
2831 CDD525 01160 CALL CPLJCL5 ;Ck on substitution
2834 7E 01161 LD A,(HL)
2835 18E6 01162 JR XFRSTR1 ;Then loop
01163 ;
01164 ; Parse a field
01165 ;
2837 78 01166 PARSER LD A,B ;Set max length of field
2838 329928 01167 LD (PAR6+1),A
283B 04 01168 INC B
283C 7E 01169 PAR2 LD A,(HL) ;P/u entry char
283D FE03 01170 CP 3 ;ETX?
283F 284C 01171 JR Z,PAR5
2841 FE0D 01172 CP CR
2843 2848 01173 JR Z,PAR5
2845 23 01174 INC HL ;Not ending char, bump
2846 FE22 01175 CP '"' ;Ck on string quote
2848 2007 01176 JR NZ,NOTQT
284A EE22 01177 XOR '"' ;Ck if opening or closing
284B 01178 STUFQT EQU $-1
284C 324B28 01179 LD (STUFQT),A
284F 18EB 01180 JR PAR2 ;Loop until terminator
2851 4F 01181 NOTQT LD C,A ;Save char & test if
2852 3A4B28 01182 LD A,(STUFQT) ; within quoted string
2855 B7 01183 OR A
2856 79 01184 LD A,C ;Get back the char
2857 2826 01185 JR Z,PAR3 ;Allow all within "..."
2859 FE40 01186 CP '@' ;Start of label?
285B 200D 01187 JR NZ,NOLBL
285D D600 01188 GOTLBL SUB 0 ;Make sure only one
285F CA6129 01189 JP Z,LBLERR
2862 325E28 01190 LD (GOTLBL+1),A ;Stuff '&' into test
2865 321625 01191 LD (FNDLBL+1),A ; & also for check
2868 18D2 01192 JR PAR2 ;Loop through start
286A FE2E 01193 NOLBL CP '.' ;Accept (., /, 0-9, :)
286C 381F 01194 JR C,PAR5
286E FE3B 01195 CP ':'+1
2870 380D 01196 JR C,PAR3
2872 FE41 01197 CP 'A' ;Test for A-Z
2874 3817 01198 JR C,PAR5
2876 FE5B 01199 CP 'Z'+1
2878 3805 01200 JR C,PAR3
287A CD3C29 01201 CALL CKLCA2Z ;Test for a-z
287D 380E 01202 JR C,PAR5
287F 05 01203 PAR3 DEC B ;Char count down
2880 2808 01204 JR Z,PAR4
2882 12 01205 LD (DE),A ;Save the char
2883 AF 01206 XOR A ;Show we found at
2884 329928 01207 LD (PAR6+1),A ; least one valid char
2887 13 01208 INC DE ;Bump receiving buffer
2888 18B2 01209 JR PAR2 ;Loop
288A 04 01210 PAR4 INC B ;Ignore trailing chars
288B 18AF 01211 JR PAR2 ; past max length
288D 4F 01212 PAR5 LD C,A ;Found char out of range
288E D5 01213 PUSH DE ;Save current end of buf
288F 1804 01214 JR PAR5B
2891 3E20 01215 PAR5A LD A,' ' ;Fill out remaining field
2893 12 01216 LD (DE),A ; with blanks
2894 13 01217 INC DE
2895 10FA 01218 PAR5B DJNZ PAR5A
2897 D1 01219 POP DE ;Recover pointer to last
2898 3E00 01220 PAR6 LD A,0 ;Char xfered, get max len
289A B7 01221 OR A ;Note if we found a char
289B 79 01222 LD A,C ;Xfer separator char
289C C9 01223 RET
01224 ;
01225 ; Xfer symbol name to table & init value
01226 ;
289D E5 01227 MOVNAME PUSH HL
289E 21AC29 01228 LD HL,CURSYM ;Current symbol buffer
28A1 010800 01229 LD BC,8 ;8 chars to move
28A4 EDB0 01230 LDIR
28A6 AF 01231 XOR A ;Zero accumulator
28A7 12 01232 LD (DE),A ;Show symbol length=0
28A8 212100 01233 LD HL,33 ;Point to 1st byte
28AB 19 01234 ADD HL,DE ; of next symbol pos and
28AC 77 01235 LD (HL),A ; show it spare
28AD E1 01236 POP HL
28AE C9 01237 RET
01238 ;
01239 ; Place symbol value into table
01240 ;
28AF E5 01241 MOVALUE PUSH HL
28B0 21B429 01242 LD HL,STRLEN ;Current value buffer
28B3 012100 01243 LD BC,33 ;Length & value
28B6 EDB0 01244 LDIR
28B8 E1 01245 POP HL
28B9 C9 01246 RET
01247 ;
01248 ; Find symbol in table
01249 ;
28BA E5 01250 FINDSYM PUSH HL
28BB 11AC29 01251 LD DE,CURSYM ;Symbol buffer
28BE 21002E 01252 LD HL,SYMTAB ;Start of table
28C1 012908 01253 LD BC,8<8!41 ;CP8, field (8,1,32)
28C4 CDE628 01254 CALL FNDPRM ;Search in progress
28C7 54 01255 LD D,H ;Xfer pointer of symbol
28C8 5D 01256 LD E,L ; or to spare slot
28C9 E1 01257 POP HL
28CA C9 01258 RET
01259 ;
01260 ; Routine to check for IF, ELSE, END
01261 ;
28CB E5 01262 CK4COND PUSH HL
28CC 21CF26 01263 LD HL,CONDTBL ;Parm table
28CF 010705 01264 LD BC,5<8!7 ;5 chars, 7-char field
28D2 1807 01265 JR CK4AS1
01266 ;
01267 ; Check on SET, RESET, ASSIGN, INCLUDE, QUIT
01268 ;
28D4 E5 01269 CK4ASSN PUSH HL
28D5 21E526 01270 LD HL,ASSNTBL ;Parm table
28D8 010A08 01271 LD BC,8<8!10 ;Parm length, field len
28DB 11AC29 01272 CK4AS1 LD DE,CURSYM ;Buffer area
28DE CDE628 01273 CALL FNDPRM ;Ck for match
28E1 5E 01274 LD E,(HL) ;Xfer vector address
28E2 23 01275 INC HL
28E3 56 01276 LD D,(HL)
28E4 E1 01277 POP HL
28E5 C9 01278 RET
01279 ;
01280 ; Scan parm table for match
01281 ;
28E6 7E 01282 FNDPRM LD A,(HL) ;End of parm table?
28E7 B7 01283 OR A
28E8 2002 01284 JR NZ,FND1 ;Jump if not
28EA 3C 01285 INC A ; else show not found
28EB C9 01286 RET
28EC 1A 01287 FND1 LD A,(DE) ;Char match?
28ED CD3C29 01288 CALL CKLCA2Z ;Convert a-z to A-Z
28F0 BE 01289 CP (HL)
28F1 2807 01290 JR Z,FND3 ;Jump if 1st matches
28F3 C5 01291 FND2 PUSH BC ; else bypass complete
28F4 0600 01292 LD B,0 ; field & go to next one
28F6 09 01293 ADD HL,BC
28F7 C1 01294 POP BC
28F8 18EC 01295 JR FNDPRM
28FA E5 01296 FND3 PUSH HL ;1st matches, ck rest
28FB D5 01297 PUSH DE
28FC C5 01298 PUSH BC
28FD 05 01299 DEC B ;Adj for 1st match
28FE 13 01300 FND4 INC DE
28FF 23 01301 INC HL
2900 1A 01302 LD A,(DE)
2901 FE20 01303 CP ' '
2903 2827 01304 JR Z,FND7 ;Stop checking on space
2905 FE0D 01305 CP CR
2907 2823 01306 JR Z,FND7 ;Or end of line
2909 CD3C29 01307 CALL CKLCA2Z ;Ck & convert a-z to A-Z
290C BE 01308 CP (HL) ;Compare remaining chars
290D 200D 01309 JR NZ,FND6 ;Jump on mismatch
290F 10ED 01310 DJNZ FND4 ;Loop to count
2911 C1 01311 FND5 POP BC ;Must have matched
2912 D1 01312 POP DE ;Bypass remaining part
2913 E1 01313 POP HL ; of field and point to
2914 C5 01314 PUSH BC ; address vector of parm
2915 48 01315 LD C,B ; in parm table
2916 0600 01316 LD B,0
2918 09 01317 ADD HL,BC
2919 C1 01318 POP BC
291A AF 01319 XOR A
291B C9 01320 RET
291C FE30 01321 FND6 CP '0' ;No match, is it ASCII?
291E 380C 01322 JR C,FND7
2920 FE3A 01323 CP '9'+1 ;0-9?
2922 380D 01324 JR C,FND8
2924 FE41 01325 CP 'A' ;A-Z?
2926 3804 01326 JR C,FND7
2928 FE5B 01327 CP 'Z'+1
292A 3805 01328 JR C,FND8
292C 7E 01329 FND7 LD A,(HL) ;If table entry also a
292D FE20 01330 CP ' ' ; space, we have a match
292F 28E0 01331 JR Z,FND5
2931 C1 01332 FND8 POP BC
2932 D1 01333 POP DE
2933 E1 01334 POP HL
2934 18BD 01335 JR FND2
01336 ENDIF
01337 ;
01338 ; Routine to ck on space or comma
01339 ;
2936 FE20 01340 CKSPCOM CP ' '
2938 C8 01341 RET Z
2939 FE2C 01342 CP ','
293B C9 01343 RET
01344 ;
01345 ; Routine to convert a-z to A-Z & set C-flag
01346 ;
293C FE61 01347 CKLCA2Z CP 'a' ;Back with C-flag if
293E D8 01348 RET C ; not a-z
293F FE7B 01349 CP 'z'+1
2941 3F 01350 CCF
2942 D8 01351 RET C
2943 EE20 01352 XOR 20H ;Make U/C & reset CF
2945 C9 01353 RET
01354 *LIST ON
01355 ;
01356 ;
01357 ; Error processing
01358 ;
2946 6F 01359 IOERR LD L,A ;Xfer errnum to HL
2947 2600 01360 LD H,0
2949 F6C0 01361 OR 0C0H ;Set brief, return
294B 4F 01362 LD C,A
294C 01363 @@ERROR ;Display error
294C+3E1A 01364 LD A,26
294E+EF 01365 RST 40
294F 1825 01366 JR ERREXIT
01367 ;
2951 21ED29 01368 SPCREQ LD HL,SPCREQ$ ;"filespec required"
01369 ;
01370 *LIST OFF
01372 *LIST ON
2954 DD 01373 DB 0DDH
2955 21B32A 01374 NESTS LD HL,NESTS$
2958 DD 01375 DB 0DDH
2959 210E2A 01376 TOOLNG LD HL,TOOLNG$ ;"symbol too long..
295C DD 01377 DB 0DDH
295D 21252A 01378 NOFIND LD HL,NOFIND$ ;"proc not found..
2960 DD 01379 DB 0DDH
2961 21392A 01380 LBLERR LD HL,LBLERR$ ;"too many proc labels..
2964 DD 01381 DB 0DDH
2965 214E2A 01382 DSKFUL LD HL,DSKFUL$ ;"can't create SYS/JCL"
2968 DD 01383 DB 0DDH
2969 217C2A 01384 PRMERR LD HL,PRMERR$ ;"parameter error"
296C DD 01385 DB 0DDH
296D 216B2A 01386 MULDEF LD HL,MULDEF$ ;"multiply defined
01387 ENDIF
01388 *LIST ON
01389 ;
2970 01390 EXTERR @@LOGOT
01391 IFEQ 00H,1
01392 LD HL,
01393 ENDIF
2970+3E0C 01394 LD A,12
2972+EF 01395 RST 40
2973 21FFFF 01396 LD HL,-1 ;Set error exit
2976 01397 ERREXIT EQU $
2976 11C000 01398 LD DE,JFCB$ ;If the output JCL file
2979 1A 01399 LD A,(DE) ; is open, then we need
297A CB7F 01400 BIT 7,A ; to close it
297C 2803 01401 JR Z,SPSAV
297E 01402 @@CLOSE
297E+3E3C 01403 LD A,60
2980+EF 01404 RST 40
2981 310000 01405 SPSAV LD SP,$-$
2984 C9 01406 RET
01407 IF @BLD631
2985 21E729 01408 DOFEXT: LD HL,SYSJCL+7 ;<631>Default to /JCL
2988 01409 @@FEXT ;<631>
2988+3E4F 01410 LD A,79
298A+EF 01411 RST 40
298B C9 01412 RET ;<631>
01413 ENDIF
01414 ;
01415 *LIST OFF
01417 *LIST ON
298C 01418 DOFCB DS 32
29AC 01419 CURSYM DS 8
29B4 01420 STRLEN DS 1
29B5 01421 VALBUF DS 32
29D5 01422 LBLSAV DS 8
29DD 00 01423 NOP ;Must be zero
01424 ENDIF
01425 ;
01426 *LIST ON
29DE 0000 01427 LINENO DW 0 ;JCL line #
01428 IF @BLD631
01429 IF @BLD631G
29E0 53 01430 SYSJCL DB 'SYSTEM/JCL',3 ;<631G>
59 53 54 45 4D 2F 4A 43
4C 03
01431 ELSE
01432 SYSJCL DB 'SYSTEM/JCL:' ;<631>
01433 ENDIF
29EB 30 01434 DRVNUM DB '0',3 ;<631>
03
01435 ELSE
01436 SYSJCL DB 'SYSTEM/JCL',3
01437 ENDIF
29ED 46 01438 SPCREQ$ DB 'File spec required',CR
69 6C 65 20 73 70 65 63
20 72 65 71 75 69 72 65
64 0D
01439 *LIST OFF
01441 *LIST ON
2A00 4C 01442 LINLNG$ DB 'Line too long',CR
69 6E 65 20 74 6F 6F 20
6C 6F 6E 67 0D
2A0E 53 01443 TOOLNG$ DB 'Symbol string too long',CR
79 6D 62 6F 6C 20 73 74
72 69 6E 67 20 74 6F 6F
20 6C 6F 6E 67 0D
2A25 50 01444 NOFIND$ DB 'Procedure not found',CR
72 6F 63 65 64 75 72 65
20 6E 6F 74 20 66 6F 75
6E 64 0D
2A39 54 01445 LBLERR$ DB 'Too many Proc labels',CR
6F 6F 20 6D 61 6E 79 20
50 72 6F 63 20 6C 61 62
65 6C 73 0D
2A4E 43 01446 DSKFUL$ DB 'Can''t create SYSTEM/JCL file',CR
61 6E 27 74 20 63 72 65
61 74 65 20 53 59 53 54
45 4D 2F 4A 43 4C 20 66
69 6C 65 0D
2A6B 4D 01447 MULDEF$ DB 'Multiply defined ' ;Follow with PRMERR$
75 6C 74 69 70 6C 79 20
64 65 66 69 6E 65 64 20
2A7C 50 01448 PRMERR$ DB 'Parameter error',CR
61 72 61 6D 65 74 65 72
20 65 72 72 6F 72 0D
01449 IF @BLD631G
2A8C 42 01450 BADJCL$ DB 'Bad JCL format, process aborted',CR ;<631G>
61 64 20 4A 43 4C 20 66
6F 72 6D 61 74 2C 20 70
72 6F 63 65 73 73 20 61
62 6F 72 74 65 64 0D
2AAC 67 01451 P631G1: LD H,A ;<631G>
2AAD 2E3A 01452 LD L,':' ;<631G>
2AAF 22EA29 01453 LD (DRVNUM-1),HL ;<631G>29EAH
2AB2 C9 01454 RET ;<631G>
01455 ELSE
01456 BADJCL$ DB 'Invalid JCL format, processing aborted',CR
01457 ENDIF
2AB3 54 01458 NESTS$ DB 'Too many nested INCLUDEs',CR
6F 6F 20 6D 61 6E 79 20
6E 65 73 74 65 64 20 49
4E 43 4C 55 44 45 73 0D
2ACC CE2A 01459 NESTPTR DW NESTFCB ;Pointer to nest FCB
2ACE 01460 NESTFCB DS 32*5 ;Space for 5 levels
2B6E 01461 NESTEND EQU $ ;Ck for too many includes
2B6E 702B 01462 CONDPTR DW CONDFLG ;Conditional pointer
2B70 00 01463 CONDFLG DB 0 ;Init 1st state to TRUE
2B71 01464 DS 31 ;32 conditional levels
2B90 4C 01465 BADHDR$ DB 'Line xxxxx -->'
69 6E 65 20 78 78 78 78
78 20 2D 2D 3E
2B9E 01466 JCLBUF1 DS 80
2C00 01467 ORG $<-8+1<+8
2C00 01468 INPBUF DS 256
2D00 01469 OUTBUF DS 256
2E00 00 01470 SYMTAB DB 0
01471 ENDIF
01472 *LIST ON
2E01 01473 CORE$ DEFL $
01474 ;
2400 01475 END DO
2400 is the transfer address
00000 Total errors
[Copyright 1999,2002 Frank Durda IV, All Rights Reserved. Mirroring of any material on this page in any form is expressly prohibited. The official web site for this material is: http://nemesis.lonestar.org Contact this address for use clearances: clearance at nemesis.lonestar.org Comments and queries to this address: web_software_2011 at nemesis.lonestar.org]