[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 21:41:08 SYS11 - LS-DOS 6.2 Page 00001
00001 ;SYS11/ASM - LS-DOS 6.2
00002 *MOD
00004 ;
000A 00005 LF EQU 10
000D 00006 CR EQU 13
00007 *LIST OFF ;Get SYS0/EQU
00323 *LIST ON
0000 00324 *GET COPYCOM:3 ;Copyright message
00325 ; COPYCOM - File for Copyright COMment block
00326 ;
0000 00327 *GET BUILDVER/ASM:3
00328 ;
00329 ; Buildver/asm is a bit of a kludge since not all utilities can load
00330 ; equates from LDOS60 and still compile. LOWCORE and everybody else
00331 ; relies on this setting, and it eventually ends up in LDOS60/EQU
00332 ; for programs that can use that.
00333 ;
FFFF 00334 @BLD631 EQU -1 ;<631>Build 631 distribution (LEVEL 1B)
00335 ; These switches activate patches made since the 1B release.
00336 ; It is important that all earlier patches be enabled when a higher
00337 ; patch is enabled.
00338 ; Patches C thru F were published in TMQ IV.iv, page 32 (NOTE: the
00339 ; patch addresses listed for SPOOL in SPOOL1/FIX are 19H high.)
FFFF 00340 @BLD631C EQU -1 ;<631>Apply 1C patches (SETKI)
FFFF 00341 @BLD631D EQU -1 ;<631>Apply 1D patches (DIR)
FFFF 00342 @BLD631E EQU -1 ;<631>Apply 1E patches (DIR & MEMDISK/DCT)
FFFF 00343 @BLD631F EQU -1 ;<631>Apply 1F patches (SPOOL)
00344 ; Patches G and H were published in TMQ V.i, pages 10 and 18/19.
FFFF 00345 @BLD631G EQU -1 ;<631>Apply 1G patches (//KEYIN,DIR,DO *)
FFFF 00346 @BLD631H EQU -1 ;<631>Apply 1H patches (MEMORY)
00347 ;
00348 ;End of BUILDVER/ASM
00349 IF @BLD631
00351 ELSE
00352 COM '<*(C) 1982,3,4,6 by LSI*>'
00353 ENDIF
00354 ;
1E00 00355 ORG 1E00H
00356 ;
1E00 E670 00357 SYS11 AND 70H
1E02 C8 00358 RET Z ;Back on zero entry
1E03 E5 00359 PUSH HL
1E04 217400 00360 LD HL,KFLAG$ ;Reset the
1E07 CB96 00361 RES 2,(HL) ; bit every time
1E09 E1 00362 POP HL
1E0A FE20 00363 CP 20H ;New @EXIT?
1E0C 2847 00364 JR Z,NEWEXIT
1E0E FE40 00365 CP 40H ;New keyboard request
1E10 CAD61E 00366 JP Z,KEYREQ ; after input of a line?
1E13 FE50 00367 CP 50H ;//INPUT followup
1E15 CABA20 00368 JP Z,GETKEY
1E18 FE10 00369 CP 10H ;Initial entry to DO?
1E1A C0 00370 RET NZ
00371 ;
00372 ; initialization of sysres hooks
00373 ;
1E1B F3 00374 DI ;Clock off for now
1E1C 217400 00375 LD HL,KFLAG$ ;Reset break bit only on
1E1F CB86 00376 RES 0,(HL) ; initial entry
1E21 217C00 00377 LD HL,SFLAG$
1E24 CB6E 00378 BIT 5,(HL) ;If DO already in effect
1E26 CBEE 00379 SET 5,(HL) ; don't rehook
1E28 2005 00380 JR NZ,IPLDO1
1E2A 3EAD 00381 LD A,0ADH ;Change @EXIT,@ABORT to use
1E2C 320C1B 00382 LD (@EXIT+1),A ; SYS11 rather than SYS1
1E2F 318003 00383 IPLDO1 LD SP,STACK$
1E32 FB 00384 EI ;Clock back on
1E33 11C000 00385 LD DE,JFCB$ ;At end of SYSTEM/JCL?
1E36 CD8F15 00386 CALL @CKEOF
1E39 C20F1B 00387 JP NZ,@ERROR
1E3C 114F1E 00388 LD DE,IPLDO2 ;Init JCLCB$
1E3F ED530402 00389 LD (JCLCB$+1),DE
1E43 CD771E 00390 CALL GETLINE ;Get a line from the file
1E46 11A919 00391 LD DE,@DOKEY ;Change vector to SYS11,
1E49 ED530402 00392 LD (JCLCB$+1),DE ; entry 4
1E4D 1825 00393 JR $?1 ;Go interpret it
1E4F 11C000 00394 IPLDO2 LD DE,JFCB$ ;JCLCB$ input routine
1E52 C33806 00395 JP @GET
00396 ;
00397 ; New @EXIT processing
00398 ;
1E55 318003 00399 NEWEXIT LD SP,STACK$ ;Reset the stack
1E58 FB 00400 EI
1E59 7C 00401 LD A,H ;Ck for error return
1E5A B5 00402 OR L
1E5B 2023 00403 JR NZ,ABORT
1E5D 217C00 00404 LD HL,SFLAG$
1E60 CB66 00405 BIT 4,(HL) ;BREAK key disabled?
1E62 2005 00406 JR NZ,NEWEX1
1E64 CD5305 00407 CALL @CKBRKC ;Check on
1E67 2017 00408 JR NZ,ABORT
1E69 11C000 00409 NEWEX1 LD DE,JFCB$ ;Exit if end of JCL
1E6C CD8F15 00410 CALL @CKEOF
1E6F 2041 00411 JR NZ,EXIT
1E71 CD771E 00412 CALL GETLINE ;Grab a JCL line
1E74 C37E19 00413 $?1 JP @CMNDI
1E77 212004 00414 GETLINE LD HL,INBUF$ ;Pt to line buffer
1E7A 01004F 00415 LD BC,79<8 ;Max 79 chars
1E7D C38505 00416 JP @KEYIN
00417 ;
00418 ; New ABORT processor
00419 ;
1E80 216821 00420 ABORT LD HL,ABORT$ ;"Job abort...
1E83 11081B 00421 LD DE,@ABORT
1E86 1830 00422 JR EXIT1
00423 ;
00424 ; Scan for ENTER or BREAK
00425 ;
1E88 3A7C00 00426 KSCN LD A,(SFLAG$) ;Only test BREAK if
1E8B CB67 00427 BIT 4,A ; BREAK key enabled
1E8D 3A7400 00428 LD A,(KFLAG$)
1E90 2004 00429 JR NZ,KSCN1
1E92 CB47 00430 BIT 0,A ;BREAK detected?
1E94 20EA 00431 JR NZ,ABORT
1E96 CB57 00432 KSCN1 BIT 2,A ;Test
1E98 C8 00433 RET Z ;Back if not
1E99 CD3506 00434 KSCN2 CALL @KBD ;Clear the type ahead
1E9C 28FB 00435 JR Z,KSCN2
1E9E 217400 00436 LD HL,KFLAG$ ;Reset the ENTER bit
1EA1 CB96 00437 RES 2,(HL)
1EA3 C5 00438 PUSH BC
1EA4 060B 00439 LD B,3000<-8
1EA6 CD8203 00440 CALL @PAUSE
1EA9 C1 00441 POP BC
1EAA 7E 00442 LD A,(HL) ;Don't return until clear
1EAB E604 00443 AND 4
1EAD EE04 00444 XOR 4
1EAF 28E8 00445 JR Z,KSCN2
1EB1 C9 00446 RET
00447 ;
00448 ; Continuation of EXIT processing
00449 ;
1EB2 217421 00450 EXIT LD HL,JOBDUN$ ;"Job done...
1EB5 110B1B 00451 LD DE,@EXIT
1EB8 D5 00452 EXIT1 PUSH DE
1EB9 CD0005 00453 CALL @LOGOT ;Log & fall thru
00454 ;
00455 ; Turn off the DO processor
00456 ;
1EBC 00457 DOOFF EQU $
1EBC F3 00458 DI
1EBD 217C00 00459 LD HL,SFLAG$ ;Reset flag
1EC0 CBAE 00460 RES 5,(HL)
1EC2 AF 00461 XOR A
1EC3 32C000 00462 LD (JFCB$),A ;Show fcb is closed
1EC6 67 00463 LD H,A ;Set = 0 for @EXIT
1EC7 6F 00464 LD L,A
1EC8 110802 00465 LD DE,KIDCB$ ;Clear any type ahead
1ECB 3E03 00466 LD A,3
1ECD CD2306 00467 CALL @CTL ; buffer (no streaming)
1ED0 3E93 00468 LD A,93H ;Restore @EXIT SVC
1ED2 320C1B 00469 LD (@EXIT+1),A ; back to SYS1
1ED5 C9 00470 RET
00471 ;
00472 ; Keyboard request processor
00473 ;
1ED6 210A00 00474 KEYREQ LD HL,10 ;Back stack up 5 words
1ED9 39 00475 ADD HL,SP ;SYS0,RET,DE,HL,IX,BC
1EDA 4E 00476 LD C,(HL) ;Get contents of BC
1EDB 23 00477 INC HL ; prior to keyboard
1EDC 46 00478 LD B,(HL) ; request & DRIVER save
00479 ;
00480 ; @KEYIN is requesting an entire line
00481 ;
1EDD 11C000 00482 KEYLINE LD DE,JFCB$ ;Ck on end of JCL file
1EE0 C5 00483 PUSH BC
1EE1 CD8F15 00484 CALL @CKEOF
1EE4 C1 00485 POP BC
1EE5 20CB 00486 JR NZ,EXIT
1EE7 78 00487 LD A,B ;Do we need to re-read
1EE8 B9 00488 CP C ; the JCL sector?
1EE9 C23806 00489 JP NZ,@GET
1EEC CD9A14 00490 CALL @RREAD ;Get the sector back
1EEF C20F1B 00491 JP NZ,@ERROR
1EF2 CD3806 00492 CALL @GET
1EF5 B7 00493 OR A
1EF6 28BA 00494 JR Z,EXIT
1EF8 FE2F 00495 CP '/' ;Is this line execution
1EFA 2802 00496 JR Z,GOTSLSH ; JCL code to parse?
1EFC BF 00497 CP A ;Set Z-flag
1EFD C9 00498 RET
00499 ;
00500 ; Found an execution code line
00501 ;
1EFE C5 00502 GOTSLSH PUSH BC
1EFF D5 00503 PUSH DE
00504 IF @BLD631G
1F00 0650 00505 LD B,80 ;<631G>Only 79+CR char line
00506 ELSE
00507 LD B,79 ;Only 79 char line
00508 ENDIF
1F02 212004 00509 LD HL,INBUF$ ;Get rest of line
1F05 E5 00510 PUSH HL ; into JCL buffer
1F06 77 00511 GOTSL1 LD (HL),A ;Compare for CR as end
1F07 23 00512 INC HL ; of line
1F08 FE0D 00513 CP CR
1F0A 2807 00514 JR Z,GOTSL2
1F0C CD3806 00515 CALL @GET ;Get a character
1F0F 10F5 00516 DJNZ GOTSL1 ; up to 79 max
1F11 183F 00517 JR BADJCL ;Line too long
1F13 E1 00518 GOTSL2 POP HL ;Rcvr pointer to buf
1F14 E5 00519 PUSH HL
1F15 23 00520 INC HL ;Pt to 2nd char
1F16 7E 00521 LD A,(HL)
1F17 FE2F 00522 CP '/' ;Found a //?
1F19 2032 00523 JR NZ,REKEY2
1F1B 23 00524 INC HL ;Ck on ///
1F1C 96 00525 SUB (HL)
1F1D CAC71F 00526 JP Z,KEYIN6 ;Jump if ///
1F20 D6F6 00527 SUB 0F6H
1F22 D2C31F 00528 JP NC,KEYIN5 ;Jump if 3rd char is 0-9
1F25 E3 00529 EX (SP),HL ;P/u start of command
1F26 CD0305 00530 CALL @LOGER ; line & log it
1F29 E3 00531 EX (SP),HL
1F2A 7E 00532 GOTSL3 LD A,(HL) ;Was char ENTER?
1F2B FE0D 00533 CP CR
1F2D 281E 00534 JR Z,REKEY2
1F2F FE20 00535 CP ' ' ;Ignore leading spaces
1F31 23 00536 INC HL
1F32 28F6 00537 JR Z,GOTSL3
1F34 2B 00538 DEC HL
1F35 115921 00539 LD DE,LILBUF ;Put possible parm -> buf
1F38 0605 00540 LD B,5 ;Max length of parm
1F3A CDCE20 00541 CALL PARSER ;Parse parm
1F3D 200E 00542 JR NZ,REKEY2
1F3F 115921 00543 LD DE,LILBUF
1F42 017D21 00544 LD BC,PARMTBL ;Is the parm a macro?
1F45 CD1721 00545 CALL FNDPARM
1F48 2003 00546 JR NZ,REKEY2 ;Bypass if not in tbl
1F4A D5 00547 PUSH DE ;Stack routine's entry
1F4B C9 00548 RET ; & go to it
1F4C C1 00549 REKEY1 POP BC
1F4D E1 00550 REKEY2 POP HL
1F4E D1 00551 POP DE
1F4F C1 00552 POP BC
1F50 188B 00553 JR KEYLINE
1F52 215F21 00554 BADJCL LD HL,BADJCL$ ;"invalid JCL...
1F55 C3831E 00555 JP ABORT+3
00556 ;
00557 ; Process //STOP
00558 ;
1F58 CDBC1E 00559 STOP CALL DOOFF ;Turn off DO proc
1F5B E1 00560 POP HL
1F5C D1 00561 POP DE
1F5D C1 00562 POP BC
1F5E FB 00563 EI
1F5F C32806 00564 JP @KEY ;Go back to keyboard
00565 ;
00566 ; Process //DELAY
00567 ;
1F62 E3 00568 DELAY EX (SP),HL ;Pt to //delay line
1F63 CD2D05 00569 CALL @DSPLY ; and display it
1F66 E3 00570 EX (SP),HL
1F67 CDE103 00571 CALL @DECHEX ;Cvrt entry to binary
1F6A 41 00572 LD B,C ;Set count
1F6B CD2220 00573 DELAY1 CALL SILEN1 ;Delay a bit
1F6E 10FB 00574 DJNZ DELAY1
1F70 18DB 00575 JR REKEY2
00576 ;
00577 ; Process //PAUSE
00578 ;
1F72 E1 00579 PAUSE POP HL ;Display "pause..
1F73 E5 00580 PUSH HL
1F74 CD2D05 00581 CALL @DSPLY
1F77 CD881E 00582 PAUSE1 CALL KSCN ;Loop for BREAK or ENTER
1F7A 28FB 00583 JR Z,PAUSE1
00584 IF @BLD631
00585 REKEY22
00586 ENDIF
1F7C 18CF 00587 JR REKEY2
00588 ;
00589 ; Process //KEYIN
00590 ;
1F7E E1 00591 KEYIN POP HL ;Rcvr pointer to "KEYIN
1F7F E5 00592 PUSH HL
1F80 7E 00593 KEYIN1 LD A,(HL) ;Display JCL command line
1F81 23 00594 INC HL
1F82 FE0D 00595 CP CR
1F84 2805 00596 JR Z,KEYIN2
1F86 CD4206 00597 CALL @DSP
1F89 18F5 00598 JR KEYIN1
1F8B CD2806 00599 KEYIN2 CALL @KEY ;Get & display the char
1F8E CD4206 00600 CALL @DSP
1F91 32C41F 00601 LD (KEYIN5+1),A ;Stuff for compare
1F94 3E0D 00602 LD A,CR
1F96 CD4206 00603 CALL @DSP ;Write new line
1F99 E1 00604 KEYIN3 POP HL
1F9A E5 00605 PUSH HL
1F9B 11C000 00606 LD DE,JFCB$ ;Ck for end of JCL
1F9E CD8F15 00607 CALL @CKEOF
1FA1 C2B21E 00608 JP NZ,EXIT
00609 KEYIN4
00610 IF @BLD631
00611 IF @BLD631G
1FA4 0650 00612 LD B,80 ;<631G>
00613 ELSE
00614 LD B,79 ;<631>
00615 ENDIF
00616 KEYIN4B
00617 ENDIF
1FA6 CD3806 00618 CALL @GET ;Xfer a line of JCL
1FA9 77 00619 LD (HL),A ; to buffer
1FAA 23 00620 INC HL
1FAB FE0D 00621 CP CR
00622 IF @BLD631
1FAD 2804 00623 JR Z,KEYIN4A ;<631>
1FAF 10F5 00624 DJNZ KEYIN4B ;<631>
1FB1 189F 00625 JR BADJCL ;<631>
00626 KEYIN4A
00627 ELSE
00628 JR NZ,KEYIN4
00629 ENDIF
1FB3 E1 00630 POP HL
1FB4 E5 00631 PUSH HL
1FB5 7E 00632 LD A,(HL) ;Look for // to find
1FB6 FE2F 00633 CP '/' ;Start of procedure block
1FB8 20DF 00634 JR NZ,KEYIN3
1FBA 23 00635 INC HL
1FBB BE 00636 CP (HL) ;//?
1FBC 20DB 00637 JR NZ,KEYIN3
1FBE 23 00638 INC HL ;Point to proc label
1FBF 96 00639 SUB (HL) ;Is label a '/' noting
1FC0 2805 00640 JR Z,KEYIN6 ; exec phase cond's end?
1FC2 7E 00641 LD A,(HL) ;Nope, get proc label
1FC3 FE00 00642 KEYIN5 CP 0 ;Same as key entry?
1FC5 20D2 00643 JR NZ,KEYIN3 ;No match? check next one
1FC7 32C41F 00644 KEYIN6 LD (KEYIN5+1),A ;Stuff 0 if ///
1FCA E1 00645 POP HL
1FCB E5 00646 PUSH HL
1FCC CD0305 00647 CALL @LOGER ;Log the command
00648 IF @BLD631
1FCF 18AB 00649 JR REKEY22 ;<631>
00650 ELSE
00651 JR REKEY2
00652 ENDIF
00653 ;
00654 ; Process //ALERT
00655 ;
1FD1 AF 00656 ALERT XOR A
1FD2 320120 00657 LD (ALERT4+1),A ;Start with clean flag
1FD5 7E 00658 ALERT1 LD A,(HL) ;Ignore spaces
1FD6 23 00659 INC HL
1FD7 FE20 00660 CP ' '
1FD9 28FA 00661 JR Z,ALERT1
1FDB FE2C 00662 CP ',' ;Comma separator?
1FDD 28F6 00663 JR Z,ALERT1
1FDF FE0D 00664 CP CR ;End of line?
1FE1 CA4D1F 00665 JP Z,REKEY2
1FE4 FE29 00666 CP ')' ;Closing paren?
1FE6 2809 00667 JR Z,ALERT2
1FE8 FE28 00668 CP '(' ;Start of parms?
1FEA 200F 00669 JR NZ,ALERT3 ;If none of the above...
1FEC 22F21F 00670 LD (ALERT2+1),HL ;Save ptr to parm start
1FEF 18E4 00671 JR ALERT1
00672 ;
00673 ; Check here when closing parm received
00674 ;
1FF1 210000 00675 ALERT2 LD HL,0 ;P/u ptr to '(' if there
1FF4 7C 00676 LD A,H ;If the //ALERT1 started
1FF5 B5 00677 OR L ; with a '(', then
1FF6 20DD 00678 JR NZ,ALERT1 ; repeat the parm
1FF8 C3521F 00679 JP BADJCL ; parsing else exit
00680 ;
00681 ; Assumed integer parm found
00682 ;
1FFB 2B 00683 ALERT3 DEC HL ;Backup pointer
1FFC CDE103 00684 CALL @DECHEX ;Cvrt value to binary
1FFF 41 00685 LD B,C ;Keep value as counter
2000 3E00 00686 ALERT4 LD A,0 ;Flip flag: entries 1, 3,
2002 EEFF 00687 XOR 0FFH ; 5, ... are noise, 2,
2004 320120 00688 LD (ALERT4+1),A ; 4, 6, ... are silence
2007 4F 00689 LD C,A
2008 CB41 00690 BIT 0,C ;Test noise or silence
200A C49203 00691 CALL NZ,@SOUND ;Call for sound out
200D CB41 00692 BIT 0,C ; then test again
200F CC1A20 00693 CALL Z,SILENCE ;Silence is golden
2012 CD881E 00694 CALL KSCN ;Ck BREAK or ENTER
2015 C24D1F 00695 JP NZ,REKEY2 ;Go on enter
2018 18BB 00696 JR ALERT1 ;Loop if not
00697 ;
00698 ; Silence routine
00699 ;
201A B0 00700 SILENCE OR B ;A was zero
201B C8 00701 RET Z
201C CD2220 00702 CALL SILEN1 ;Delay a bit
201F 10F9 00703 DJNZ SILENCE ; for duration
2021 C9 00704 RET
2022 C5 00705 SILEN1 PUSH BC ;Delay for 0.1 sec
2023 019B19 00706 LD BC,6555
2026 CD8203 00707 CALL @PAUSE
2029 C1 00708 POP BC
202A C9 00709 RET
00710 ;
00711 ; Process //FLASH
00712 ;
202B CDE103 00713 FLASH CALL @DECHEX
202E 41 00714 LD B,C ;P/u the flash count
202F E1 00715 POP HL
2030 E5 00716 PUSH HL
2031 C5 00717 FLASH1 PUSH BC
2032 CD2D05 00718 CALL @DSPLY ;Display the prompt
2035 010040 00719 LD BC,4000H ;Countdown to flash msg
2038 CD881E 00720 FLASH2 CALL KSCN ;Keep testing
203B C24C1F 00721 JP NZ,REKEY1 ; key during countdown
203E 0B 00722 DEC BC ;BREAK would abort
203F 78 00723 LD A,B
2040 B1 00724 OR C
2041 20F5 00725 JR NZ,FLASH2 ;Loop until count=0
2043 3E1B 00726 LD A,27 ;Erase the message line
2045 CD4206 00727 CALL @DSP
2048 3E1E 00728 LD A,30
204A CD4206 00729 CALL @DSP
204D CD2220 00730 CALL SILEN1 ;Delay while blanked
2050 C1 00731 POP BC
2051 10DE 00732 DJNZ FLASH1
2053 C34D1F 00733 FLASH3 JP REKEY2
00734 ;
00735 ; Process //SLEEP and //WAIT
00736 ;
2056 3E 00737 SLEEP DB 3EH ;Make it LD A,0AFH
2057 AF 00738 WAIT XOR A
2058 327720 00739 LD (SLPWT+1),A ;Save entry state
205B E3 00740 EX (SP),HL ;Display the JCL line
205C CD2D05 00741 CALL @DSPLY
205F E3 00742 EX (SP),HL
2060 115921 00743 LD DE,TIMFLD ;Pt to time field
2063 0603 00744 LD B,3 ;Set up loop counter
2065 1805 00745 JR PAKTIM1
2067 FE0A 00746 PAKTIM CP ':'-30H ;Test valid separator
2069 C2521F 00747 JP NZ,BADJCL
206C C5 00748 PAKTIM1 PUSH BC
206D CDE103 00749 CALL @DECHEX ;Cvrt the hours
2070 71 00750 LD (HL),C ;Store time parm
2071 EDA0 00751 LDI ;Shift & bump HL & DE
2073 C1 00752 POP BC ;Rcvr the loop counter
2074 10F1 00753 DJNZ PAKTIM ;Loop for 3 values
2076 3E00 00754 SLPWT LD A,0 ;P/u sleep/wait flag
2078 B7 00755 OR A
2079 281F 00756 JR Z,TSTIME ;Go if //WAIT
207B 215B21 00757 LD HL,TIMFLD+2 ;Point to seconds
207E 112D00 00758 LD DE,TIME$
2081 0602 00759 LD B,2
2083 1A 00760 SLP1 LD A,(DE) ;Add secs/mins
2084 86 00761 ADD A,(HL)
2085 77 00762 LD (HL),A ;Store
2086 D63C 00763 SUB 60 ;Ck overflow to mins/hrs
2088 3804 00764 JR C,SLP2 ;Go if none
208A 77 00765 LD (HL),A ;Update value mod 60
208B 2B 00766 DEC HL ; & bump next field
208C 34 00767 INC (HL)
208D 23 00768 INC HL ;Adj for dec
208E 13 00769 SLP2 INC DE ;Bump time$
208F 2B 00770 DEC HL ;Bump user field
2090 10F1 00771 DJNZ SLP1
2092 1A 00772 LD A,(DE) ;Add hours
2093 86 00773 ADD A,(HL)
2094 77 00774 LD (HL),A
2095 D618 00775 SUB 24 ;Wrap past midnight?
2097 3801 00776 JR C,TSTIME ;Go if not else
2099 77 00777 LD (HL),A ; adjust mod 24
00778 ;
00779 ; Wait until the system clock advances to request
00780 ;
209A CD881E 00781 TSTIME CALL KSCN ;Scan for BREAK
209D 215921 00782 LD HL,TIMFLD
20A0 112F00 00783 LD DE,TIME$+2
20A3 0603 00784 LD B,3 ;Set loop counter
20A5 1A 00785 CKTIME LD A,(DE) ;P/u a time value
20A6 BE 00786 CP (HL) ;Match user input?
20A7 20F1 00787 JR NZ,TSTIME ;Go if no match
20A9 23 00788 INC HL ;Inc the user req ptr
20AA 1B 00789 DEC DE ;Dec the time string ptr
20AB 10F8 00790 DJNZ CKTIME ;Loop for 3 values
20AD 18A4 00791 JR FLASH3 ;All match, exit!
00792 ;
00793 ; Process //INPUT request
00794 ;
20AF E1 00795 INPUT POP HL ;Recover JCL line &
20B0 CD2D05 00796 CALL @DSPLY ; pump it to screen
20B3 3EDD 00797 LD A,0DDH ;Change sysres hook
20B5 32AA19 00798 LD (@DOKEY+1),A
20B8 D1 00799 POP DE ;Stack integrity
20B9 C1 00800 POP BC ;Get @KEYIN values
00801 ;
00802 ; This next routine will satisfy the request
00803 ;
20BA CD2806 00804 GETKEY CALL @KEY ;Fetch from keyboard
20BD F5 00805 PUSH AF ;Don't disturb flag
20BE 3D 00806 DEC A
20BF 2806 00807 JR Z,UNHOOK ;Change back on BREAK
20C1 FE0C 00808 CP CR-1 ; or ENTER
20C3 2802 00809 JR Z,UNHOOK
20C5 F1 00810 POP AF
20C6 C9 00811 RET
20C7 3ECD 00812 UNHOOK LD A,0CDH ;Restore sysres hook
20C9 32AA19 00813 LD (@DOKEY+1),A
20CC F1 00814 POP AF ;Get saved character
20CD C9 00815 RET
00816 ;
00817 ; Parameter list & scanners
00818 ;
00819 ; Parse a field
00820 ; (HL) => command line
00821 ; (DE) => FCB area
00822 ; Z <= found valid field
00823 ; NZ <= found invalid field
00824 ;
20CE 0608 00825 PARSER LD B,8 ;Set length
20D0 78 00826 PAR1 LD A,B
20D1 320521 00827 LD (PAR6+1),A
20D4 04 00828 INC B
20D5 7E 00829 PAR2 LD A,(HL)
20D6 FE03 00830 CP 3 ;ETX?
20D8 2826 00831 JR Z,PAR5
20DA FE0D 00832 CP CR ;?
20DC 2822 00833 JR Z,PAR5
20DE FE28 00834 CP '(' ;Begin of parm?
20E0 281E 00835 JR Z,PAR5
20E2 23 00836 INC HL ;Bump pointer to next
20E3 CD0921 00837 CALL TST09AZ ;Test if 0-9,A-Z
20E6 300A 00838 JR NC,PAR3 ;Go if one of the above
20E8 FE61 00839 CP 'a' ;Check on lower case
20EA 3814 00840 JR C,PAR5 ;Jump on non-alpha
20EC FE7B 00841 CP 'z'+1 ;Is it a-z?
20EE 3010 00842 JR NC,PAR5 ;Jump on non-alpha
20F0 CBAF 00843 RES 5,A ;Convert lower to upper
20F2 05 00844 PAR3 DEC B ;Count down
20F3 2808 00845 JR Z,PAR4
20F5 12 00846 LD (DE),A ;Xfer the char
20F6 AF 00847 XOR A ;Show at least 1 valid
20F7 320521 00848 LD (PAR6+1),A ; char was detected
20FA 13 00849 INC DE ;Bump FCB pointer
20FB 18D8 00850 JR PAR2 ;Loop
00851 ;
20FD 04 00852 PAR4 INC B ;Here on max chars ck'd
20FE 18D5 00853 JR PAR2
2100 4F 00854 PAR5 LD C,A ;Save separator
2101 3E03 00855 LD A,3 ;Stuff ETX
2103 12 00856 LD (DE),A
2104 3E00 00857 PAR6 LD A,0 ;Set Z-flag if at least
2106 B7 00858 OR A ; 1 valid char detected
2107 79 00859 LD A,C ;Recover separator char
2108 C9 00860 RET
2109 FE30 00861 TST09AZ CP '0' ;Special character?
210B D8 00862 RET C ;Go if not in range
210C FE3A 00863 CP '9'+1 ;Jump on digit 0-9
210E 3805 00864 JR C,EXITC ;Go if 0-9 & make NC
2110 FE41 00865 CP 'A' ;Jump on spec char
2112 D8 00866 RET C ;Go with C-flag if 3B-40
2113 FE5B 00867 CP 'Z'+1 ;Jump on A-Z
2115 3F 00868 EXITC CCF ;Switch flag of result
2116 C9 00869 RET
00870 ;
00871 ; Find parameter in table
00872 ; (HL) => pointer to line
00873 ; (DE) => pointer to buffer area
00874 ; (BC) => pointer to parameter table
00875 ; C <= entry # of parm in table
00876 ; (DE) <= parm vector address
00877 ; Z <= set if found
00878 ; NZ <= if not found in table
00879 ; Routine similar as FIND.PARM in SYS1 - dif width
00880 ;
2117 E5 00881 FNDPARM PUSH HL
2118 60 00882 LD H,B ;Xfer the table address
2119 69 00883 LD L,C
211A 1A 00884 FND1 LD A,(DE) ;P/u input byte
211B BE 00885 CP (HL) ;Match 1st char of table?
211C 280D 00886 JR Z,FND3 ;Jump if 1st matches
211E C5 00887 FND2 PUSH BC ; else bypass that entry
211F 010700 00888 LD BC,7 ;Width of table
2122 09 00889 ADD HL,BC
2123 C1 00890 POP BC
2124 7E 00891 LD A,(HL) ;Test for table end
2125 B7 00892 OR A
2126 20F2 00893 JR NZ,FND1 ;Loop if not at end
2128 E1 00894 POP HL
2129 3C 00895 INC A ; else set NZ return
212A C9 00896 RET
00897 ;
00898 ; 1st matches, does the rest?
00899 ;
212B 0604 00900 FND3 LD B,4 ;# chars remaining
212D E5 00901 PUSH HL
212E D5 00902 PUSH DE
212F 13 00903 FND4 INC DE
2130 23 00904 INC HL
2131 1A 00905 LD A,(DE) ;P/u input char
2132 FE03 00906 CP 3 ;ETX?
2134 281A 00907 JR Z,FND7
2136 FE0D 00908 CP CR ;End of line?
2138 2816 00909 JR Z,FND7
213A BE 00910 CP (HL) ;Match with table?
213B 200E 00911 JR NZ,FND6 ;Exit & test the char
213D 10F0 00912 DJNZ FND4 ;Loop for limit
213F D1 00913 FND5 POP DE ;Must be a match
2140 C1 00914 POP BC
2141 210500 00915 LD HL,5 ;Point to vector
2144 09 00916 ADD HL,BC
2145 5E 00917 LD E,(HL) ;Xfer vector to DE
2146 23 00918 INC HL
2147 56 00919 LD D,(HL)
2148 E1 00920 POP HL
2149 AF 00921 XOR A ; & show it found
214A C9 00922 RET
00923 ;
00924 ; No match if alphanumeric unless a space
00925 ;
214B CD0921 00926 FND6 CALL TST09AZ ;Ck for 0-9, A-Z
214E 3005 00927 JR NC,FND8 ;Go if one of the above
2150 7E 00928 FND7 LD A,(HL) ;Loop if table has
2151 FE20 00929 CP ' ' ; trailing spaces
2153 28EA 00930 JR Z,FND5
2155 D1 00931 FND8 POP DE
2156 E1 00932 POP HL
2157 18C5 00933 JR FND2
00934 ;
2159 00935 LILBUF DS 6
2159 00936 TIMFLD EQU LILBUF
215F 42 00937 BADJCL$ DB 'Bad JCL, '
61 64 20 4A 43 4C 2C 20
2168 4A 00938 ABORT$ DB 'Job aborted',CR
6F 62 20 61 62 6F 72 74
65 64 0D
2174 4A 00939 JOBDUN$ DB 'Job done',CR
6F 62 20 64 6F 6E 65 0D
217D 41 00940 PARMTBL DB 'ABORT'
42 4F 52 54
2182 801E 00941 DW ABORT
2184 41 00942 DB 'ALERT'
4C 45 52 54
2189 D11F 00943 DW ALERT
218B 44 00944 DB 'DELAY'
45 4C 41 59
2190 621F 00945 DW DELAY
2192 45 00946 DB 'EXIT '
58 49 54 20
2197 B21E 00947 DW EXIT
2199 46 00948 DB 'FLASH'
4C 41 53 48
219E 2B20 00949 DW FLASH
21A0 4B 00950 DB 'KEYIN'
45 59 49 4E
21A5 7E1F 00951 DW KEYIN
21A7 50 00952 DB 'PAUSE'
41 55 53 45
21AC 721F 00953 DW PAUSE
21AE 53 00954 DB 'SLEEP'
4C 45 45 50
21B3 5620 00955 DW SLEEP
21B5 53 00956 DB 'STOP '
54 4F 50 20
21BA 581F 00957 DW STOP
21BC 57 00958 DB 'WAIT '
41 49 54 20
21C1 5720 00959 DW WAIT
21C3 49 00960 DB 'INPUT'
4E 50 55 54
21C8 AF20 00961 DW INPUT
21CA 00 00962 NOP
21CB 00963 LAST EQU $
00964 IFGT $,DIRBUF$
00965 ERR 'Module too big'
00966 ENDIF
23FE 00967 ORG MAXCOR$-2
23FE CB03 00968 DW LAST-SYS11 ;Overlay size
00969 ;
1E00 00970 END SYS11
1E00 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]