github.com/moshix.mvs
1
0
Fork 0
mirror of https://github.com/moshix/mvs.git synced 2026-02-16 20:21:09 +00:00
Code Issues Releases Wiki Activity
Files
4a797409f1237cf9dfda4a03501aee7573c2f03c
moshix.mvs/PC370_orig/Diskette/full/UTIL/SEE.ALC

3227 lines
99 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE 'SEE.ALC - PC/370 SCREEN EDITOR AND EMULATOR'
*
* AUTHOR. Don Higgins.
*
* DATE. 04/06/86.
*
* REMARKS. PC/370 screen editor and emulator.
*
* COPYRIGHT. Copyright (c) 1988 Donald S. Higgins.
*
* This source program and its derivative object and
* machine code programs may be freely copied and
* distributed provided this copyright message in the
* source program and in the object program help screen
* is not removed or modified, and that no fee is charged.
* The remainder of the program may be modified as you see
* fit to customize it to your specific needs. If you send
* me useful enhancements, I will include them in the next
* release of PC/370 with appropriate credits. If you find
* PC/370 of value, support continued updates by registering
* as a PC/370 user.
*
* Don Higgins
* 6365 - 32 Avenue North
* St. Petersburg, Florida 33710
*
* MAINTENANCE
*
* 07/19/86 DSH TESTING OF SEE R1.0 VERSION COMPLETED AND READY FOR SHIP WITH
* RELEASE R1.2 OF PC/370.
* 09/11/86 DSH SEE RELEASE 1.1
* 1. ADD BOX MODE LOGIC TO CONNECT SINGLE AND DOUBLE LINES AT
* INTERSECTIONS.
* 2. MODIFY F1 SCREEN FOR FPC HELP # FOR INTERNAL USE.
* 3. SET FILE DEFAULT TO TEST.ALC INSTEAD OF BLANK NAME.
* 09/16/86 DSH SEE RELEASE 1.2
* 1. ADD ALT-F10 BOX CONNECT MODE TOGGLE KEY.
* 09/19/86 DSH SEE RELEASE 1.3
* 1. FIX SINGLE LINE CROSSING VERTICAL DOUBLE LT TO RT.
* 04/28/87 DSH SEE RELEASE 1.4
* 1. FIX SEARCH AND REPLACE TO SET FILEMOD IF MATCH.
* 2. STARTUP IN INSERT MODE FOR NEW FILE.
* 3. ALLOW 132 BYTE INPUT RECORDS TRUNCATED TO 80.
* 04/29/87 DSH SEE RELEASE 2.0
* 1. CONVERT TO PC/370 RELEASE 2.0 WITH NEW FILE PATHING
* I/O SUPPORT WITH NEW DCB.
* 2. USE GETMAIN/FREEMAIN IN VIRTUAL ADDRESS SPACE INSTEAD
* OF CROSS MEMORY MVCP/MVCS.
* 05/21/87 DSH - UPDATE SOURCE AND HELP SCREEN MESSAGES
*
* 07/12/87 DSH SEE RELEASE 2.1
* 1. SUPPORT TABS FOR COL. 10, 16, AND 5 BLKS IN TEXT
* 2. UPDATE FROM SCREEN BEFORE F8 SEARCH STARTS
* 01/03/88 DSH SEE RELEASE 2.2
* 1. USE STANDARD EBCDIC PARM LIST AT X'80'
*
* INPUT
*
* 1. A>SEE file1 file2
*
* file1 - Name of new or existing ASCII text file to edit.
* Maximum size is about 512k with 640k memory.
* The default suffix is ALC.
*
* file2 - Optional name of new or existing keyboard simulator file.
* The default suffix is KSF. If the file is new all keystrokes
* entered during the current edit session will be recorded in
* the file. If the file is old, the entire edit session will
* be simulated using the keystrokes in the file. This feature
* is used to run validation tests on the editor. It can also
* be used to create animated displays for demonstrations.
*
* OUTPUT
*
* 1. Input file1 will be replaced with new file with changes.
* 2. Old file1 will be renamed with suffix of (.BAK).
* 3. Keyboard controls are designed to be compatible with
* both TURBO PASCAL and PFS:WRITE. For definitions see
* F1 and F2 help screen text in data section of program.
* (you can search via (F7) for label F1SC and F2SC)
*
*
SEE CSECT
USING *,R15
STM R14,R12,12(R13)
BAL R15,START
DROP R15
DC 18F'0'
START EQU *
ST R13,4(R15)
ST R15,8(R13)
LR R13,R15
USING SEE+8,R13
LA R8,2048(R13)
LA R8,2048(R8)
USING SEE+8+4096,R8
LA R9,2048(R8)
LA R9,2048(R9)
USING SEE+8+4096+4096,R9
LA R10,2048(R9)
LA R10,2048(R10)
USING SEE+8+4096+4096+4096,R10
BAL R14,GETPARM PROCESS PARM FILE NAMES
LTR R15,R15
BNZ SEEEND
BAL R14,INIT INITIALIZE SCREEN AND POINTERS
LTR R15,R15
BNZ SEEEND
BAL R14,LOADFILE LOAD FILE INTO EXTENDED STORAGE
CLI EOJ,TRUE
BE SEEEND
BAL R14,EDITFILE EDIT FILE IN FULL SCREEN MODE
BAL R14,SAVEFILE SAVE FILE IF MODIFIED
BAL R14,TERMKSF TERMINATE KSF IF ACTIVE
SEEEND EQU *
LA R0,X'0003' AH=0,AL=2 FOR 25X80 COLOR MODE
SVC VIDEO SET MODE AND CLEAR SCREEN (TECH. A-48)
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,X'0000' DH=ROW,DL=COL
SVC VIDEO SET CURSOR TO UPPER LEFT CORNER
LA R0,X'0920' AH=10, AL=SPACE
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.
LA R1,X'07' CLEAR SCREEN WITH BLACK ON WHITE
LA R14,25*80 CHARACTERS ON DATA LINES
SVC VIDEO CLEAR DATA LINES
LA R0,X'0B00'
SR R1,R1
SVC VIDEO RESET BACKGROUND TO MS-DOS BLACK
SVC EXIT EXIT TO MS-DOS
TITLE 'GETPARM - MOVE PARM TO DCB'
GETPARM EQU *
TM 0(R1),X'80' VERIFY STD. OS/VS SINGLE ADDR. PARM
BZ GETPERR
L R1,0(R1) USE STD OS/VS PARM - DSH 01/03/88
LH R4,0(R1)
GETDSN1 EQU *
LA R3,2(R1) R3 = ADDRESS COMMAND PATH/FILENAME
CH R4,=H'1'
BL GETDSN2 USE DEFAULT IF NO FILENAME
LA R5,DSN1 R5 = SYSUT1 PATH/FILENAME
SR R6,R6 R6 = ADDR OF SUFFIX . IF ANY
SKPLSP1 EQU * SKIP LEADING SPACES
CLI 0(R3),C' '
BNE MVCDSN1
LA R3,1(R3)
BCT R4,SKPLSP1
B KSDONE USE DEFAULT IF ALL BLANKS
MVCDSN1 EQU *
CLI 0(R3),C' ' IF SPACE, CHK SUFFIX
BE CHKALC
MVC 0(1,R5),0(R3)
CLI 0(R5),C'.'
BNE SKPPD1
LR R6,R5
ST R6,ATYPE1 SAVE ADDRESS OF .XXX IN DSN1
SKPPD1 EQU *
LA R5,1(R5)
SKPBLK1 LA R3,1(R3)
BCT R4,MVCDSN1
CHKALC EQU *
MVI 0(R5),X'00' ADD ZERO BYTE
LTR R6,R6
BZ ADDALC
CLC 0(4,R6),=C'.ALC'
BE GETDSN2
MVI ALC,FALSE
B GETDSN2
ADDALC EQU *
ST R5,ATYPE1 SAVE ADDRESS OF .ALC ADDED TO DSN1
MVC 0(4,R5),=C'.ALC'
MVI 4(R5),X'00' ADD ZERO BYTE
*
* PROCESS SECOND FILE PARM IF PRESENT AS KEYBOARD SIMULATOR FILE
*
GETDSN2 EQU *
CH R4,=H'1'
BL KSDONE IF NO SECOND FILE, EXIT NOW
LA R5,DSN2 R5 = SYSUT2 PATH/FILENAME
SR R6,R6 R6 = ADDR OF SUFFIX . IF ANY
MVCDSN2 EQU *
CLI 0(R3),C' ' IF SPACE, CHK SUFFIX
BE SKPBLK2
MVC 0(1,R5),0(R3)
CLI 0(R5),C'.'
BNE SKPPD2
LR R6,R5
SKPPD2 EQU *
LA R5,1(R5)
SKPBLK2 LA R3,1(R3)
BCT R4,MVCDSN2
CHKKSF EQU *
MVI 0(R5),X'00' ADD ZERO BYTE
LTR R6,R6
BNZ SKPTYP2
ADDKSF EQU *
MVC 0(4,R5),=C'.KSF'
MVI 4(R5),X'00' ADD ZERO BYTE
SKPTYP2 EQU *
MVI KSMODE,KSREAD ASSUME READ MODE
LA R2,SYSUT2
USING IHADCB,R2
SVC SEARCH
CLM R0,1,=X'00'
BE KSOPEN
MVI KSMODE,KSWRITE IF NOT FOUND, SET WRITE MODE
MVC KSNEXT,=A(KSREC) RESET POINTER FOR WRITE
MVI MACRF,C'P' RESET DCB TO PUT
DROP R2
KSOPEN EQU *
******* MVI AUDIT,TRUE SET DEFAULT AUDIT MODE FOR EMULATION
LA R2,SYSUT2
SVC OPEN
KSDONE EQU *
CLI KSMODE,KSREAD
BE KSSKPOFF
SVC TRACE
DC C'IOF ' TURN KEYBOARD INTERRUPTS OFF
KSSKPOFF EQU *
SR R15,R15
BR R14
GETPERR EQU * INVALID PARM ERROR
LA R2,=C'INVALID PARM LIST$'
SVC WTO
LA R15,16
BR R14
TITLE 'INIT - INITIALIZE SCREEN AND POINTERS'
INIT EQU *
ST R14,INITSV14
LA R0,X'0003' AH=0,AL=2 FOR 25X80 COLOR MODE
SVC VIDEO SET MODE AND CLEAR SCREEN (TECH. A-48)
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,X'0000' DH=ROW,DL=COL
SVC VIDEO SET CURSOR TO UPPER LEFT CORNER
LA R0,X'0920' AH=10, AL=SPACE
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.
IC R1,ATTRIB
LA R14,25*80 CHARACTERS ON DATA LINES
SVC VIDEO CLEAR DATA LINES
LA R0,X'0B00' AH=11 FOR SET COLOR PALETTE (TECH. A-49)
SR R1,R1
IC R1,ATTRIB
SRL R1,4
N R1,=X'00000007' TURN OFF BLINK BIT
SVC VIDEO SET BACKGROUND COLOR TO SAME AS ATTRIB
L R1,=X'00FFFFFF'
SVC GETMAIN
CLM R0,1,=X'00'
BE E02 VERIFY MAX. MEMORY SET IN R1
SH R1,=AL2(LBUFFS) REDUCE ALLOCATED MEMORY FOR BUFFERS
BNP E02
SVC GETMAIN ALLOCATE IT
ST R2,ASCB ALLOCATE AREA FOR SCREEN
SH R1,=AL2(24*LSCB) REDUCE ALLOCATED BY SCB'S
BNP E02
AH R2,=AL2(23*LSCB)
ST R2,MAXSCB ADDR OF LAST SCB
AH R2,=AL2(LSCB) UPDATE R2 TO START TO TEXT AREA
ST R1,GFQEL SET LENGTH OF EXTENDED STORAGE
ST R2,GFQEA SET ADDRESS
ST R2,MINMEM SAVE LOW LIMIT
AR R2,R1
ST R2,MAXMEM SAVE MAX LIMIT
SR R0,R0
D R0,=A(LLB)
ST R1,FMAXLINE SET MAX LINES POSSIBLE
LA R1,F1SC
LA R2,F1SCEND-F1SC
SVC EBCASC
L R1,=A(F2SC)
LA R2,F2SCEND-F2SC
SVC EBCASC
L R14,INITSV14
BR R14
TITLE 'LOADFILE - READ FILE INTO LB CHAIN IN EXTENDED MEMORY'
LOADFILE EQU *
ST R14,LOADSV14
MVI EOF1,FALSE
MVC STATNAME,DSN1 MOVE DSN TO STATUS LINE
LA R3,STATLINE
LA R4,L'STATLINE
BAL R14,PUTSTAT PRINT ENTIRE STATUS LINE ONCE
BAL R14,KEYSTATS
BAL R14,CLEAR
LA R2,F1SC
L R3,=A(F1SCEND)
BAL R14,HELPSCRN
LA R2,SYSUT1
SVC SEARCH
CLM R0,1,=X'00' DOES FILE EXIST
BNE NULLFILE NO, GO BUILD NEW FILE
LA R2,SYSUT1
SVC OPEN
MVC WLBPREV,=A(0)
L R12,MINMEM
USING LB,R12
ST R12,GLBFIRST
LA R5,100
LOADLOOP EQU *
LA R3,LLB(R12)
ST R3,WLBNEXT
CL R3,MAXMEM VERIFY NOT OUT OF MEMORY
BNL LOADERR
LA R1,WLBLINE
LA R2,SYSUT1
SVC GET READ RECORD INTO LB
LA R1,WLBLINE
LOADTABS EQU * EXPAND TABS
TRT 0(80,R1),FINDTAB FIND TAB OR EOR
BZ LOADSKPT EXIT IF NONE
CLM R2,1,=AL1(ASCLF) IS IT EOR
BE LOADSKPT EXIT IF EOR
MVC SAVETEXT,1(R1) SAVE REMAINING TEXT AFTER TAB
MVC 0(9,R1),=9AL1(ASCBLK) INSERT MAX BLANKS
CL R1,=A(WLBLINE+9) IS THIS TAB TO COL. 10
BNL LOADCK16
LA R1,WLBLINE+9 YES, SKIP TO COL. 10
B LOADREM
LOADCK16 EQU *
CL R1,=A(WLBLINE+15) IS THIS TAB TO COL. 16
BNL LOADSKP5
LA R1,WLBLINE+15 YES, SKIP TO COL. 16
B LOADREM
LOADSKP5 EQU * NO, SKIP 5 COLUMNS
LA R1,5(R1)
LOADREM EQU *
MVC 0(80,R1),SAVETEXT CONCATENATE REMAINING TEXT
B LOADTABS CONTINUE SCAN FOR TABS
LOADSKPT EQU *
MVC LB(LLB),WLB MOVE LB TO MEMORY
ST R12,WLBPREV
LR R12,R3
BCT R5,LOADLOOP
AP PTOTAL,=P'100'
MVC STATREC,=X'402020202020'
ED STATREC,PTOTAL
LA R3,STATREC
LA R4,L'STATREC
BAL R14,PUTSTAT
ZAP PLSTLINE,PTOTAL
BAL R14,PUTPCT
LA R1,WLBLINE
LA R2,SYSUT1
LA R5,100
B LOADLOOP
NULLFILE EQU *
MVI KBINS,INSSTATE START IN INSERT FOR NEW FILE
BAL R14,NEWFILE
LA R1,=CL20'NEW FILE'
BAL R14,PUTMSG
B LOADSKPC
LOADERR EQU *
MVI EOJ,TRUE SHUT DOWN IF LOAD ERR
LA R1,=CL20'* OUT OF MEMORY *'
BAL R14,PUTMSG
BAL R14,GETKEY
B LOADSKPC
EOFUT1 EQU * NORMAL END OF FILE ON INPUT
CVD R5,PWORK
ZAP PLSTLINE,=P'100'
SP PLSTLINE,PWORK
AP PLSTLINE,PTOTAL CALC TOTAL LINES LOADED
L R12,WLBPREV
MVC LBNEXT,=A(0) RESET NEXT IN LAST LB
ST R12,GLBLAST
ST R3,GFQEA UPDATE FREE MEMORY START
L R4,MAXMEM
SR R4,R3
ST R4,GFQEL UPDATE REMAINING FREE LENGTH
ZAP PCUR,=P'1'
MVC GLBCUR,GLBFIRST RESET TO FIRST LB
LA R2,SYSUT1
SVC CLOSE
BAL R14,PUTPCT
LOADSKPC EQU *
BAL R14,AUDITMS
L R14,LOADSV14
BR R14
TITLE 'EDITFILE ENTER FULL SCREEN MODE TO BROWZE/CHANGE FILE'
EDITFILE EQU *
ST R14,EDITSV14
LA R1,=CL20'EDIT'
BAL R14,PUTMSG
BAL R14,DISPLAY DISPLAY 24 LINES PLUS STATUS
EDITLOOP EQU *
BAL R14,GETKEY GET NEXT KEY INPUT
SR R2,R2 CLEAR FUNCTION CODE REG.
TRT KEY,KEYTAB
L R0,WAITLOOP LOOP ON BCT FOR COUNT IN WAITLOOP
BCT R0,*
L R15,KRTAB(R2)
BALR R14,R15 PROCESS KEY
BAL R14,AUDITSCB AUDIT SCB'S IF AUDIT ON
CLI EOJ,TRUE IS IT END OF JOB (ESCAPE KEY)
BNE EDITLOOP
L R14,EDITSV14
BR R14
TITLE 'SAVEFILE RENAME OLD FILE AND WRITE NEW FILE IF CHANGED'
SAVEFILE EQU *
ST R14,SAVESV14
ST R5,SAVEROW
ST R6,SAVECOL
ST R7,SAVESCB
LA R1,=CL20'SAVING'
BAL R14,PUTMSG
BAL R14,UPDATE UPDATE FILE WITH ANY CHANGES ON SCREEN
CLI FILEMOD,TRUE HAS FILE CHANGED
BNE SAVESKIP NO, EXIT NOW
MVI EOF1,FALSE
MVI SYSUT1+(MACRF-IHADCB),C'P' CHANGE DCB FROM GET TO PUT
CLI FIRSTSAV,TRUE
BNE SAVESKPR IF NOT FIRST SAVE, SKIP RENAME
MVI FIRSTSAV,FALSE
LA R2,SYSUT1
USING IHADCB,R2
SVC SEARCH
CLM R0,1,=X'00'
BNE SAVESKPR IF NO OLD FILE, SKIP
L R1,ATYPE1
MVC SAVETYPE,1(R1) SAVE ORIG. TYPE
MVC 1(3,R1),=C'BAK'
SVC SEARCH
CLM R0,1,=X'00'
BNE SKPDEL IF NO BKP, SKIP DELETE
SVC DELETE DELETE OLD BACKUP IF PRESENT
SKPDEL EQU *
MVC REN1(64),DSN1 COPY FILE NAME TO RENAME
L R1,ATYPE1
MVC 1(3,R1),SAVETYPE RESTORE OLD FILE NAME
SVC RENAME RENAME OLD FILE TO BKP
SAVESKPR EQU *
LA R2,SYSUT1
SVC OPEN
L R12,GLBFIRST
USING LB,R12
LA R5,100
ZAP PTOTAL,=P'0'
XC FINDKEY,FINDKEY
MVI FINDKEY+ASCCR,X'FF'
SAVELOOP EQU *
LTR R12,R12
BZ SAVEEXIT
MVC WLB(LLB),LB MOVE NEXT LB TO WORKING STORAGE
MVC WLBLINE+L'WLBLINE(2),=AL1(ASCCR,ASCLF) RESET PAD
TRT WLBLINE(81),FINDKEY FIND END OF RECORD
LA R2,1(R1)
S R2,=A(WLBLINE)
SAVEBLKL EQU *
BCTR R1,0 BACKUP TO FIRST NON-BLANK
CLI 0(R1),ASCBLK
BNE SAVEBLKE
BCT R2,SAVEBLKL
SAVEBLKE EQU *
MVC 1(2,R1),=AL1(ASCCR,ASCLF) PUT CR,LF AFTER LAST CHAR
LA R1,WLBLINE
CLI ALC,TRUE IS FILE TYPE ALC
BNE SAVESKPT
CLC WLBLINE(9),=9AL1(ASCBLK) ARE THERE 9 LEADING BLANKS
BNE SAVESKPT
MVI WLBLINE+8,ASCTAB INSERT TAB
LA R1,WLBLINE+8 WRITE FROM TAB
SAVESKPT EQU *
LA R2,SYSUT1
SVC PUT PUT RECORD
L R12,WLBNEXT
BCT R5,SAVELOOP REPEAT 100 TIMES
AP PTOTAL,=P'100'
MVC STATREC,=X'402020202020'
ED STATREC,PTOTAL
LA R3,STATREC
LA R4,L'STATREC
BAL R14,PUTSTAT PRINT RECORD # EVERY 100 RECORDS
LA R5,100
B SAVELOOP
SAVEEXIT EQU *
LA R2,SYSUT1
SVC CLOSE
MVI FILEMOD,FALSE
SAVESKIP EQU *
L R5,SAVEROW
L R6,SAVECOL
L R7,SAVESCB
L R14,SAVESV14
BR R14
TITLE 'DISPLAY - DISPLAY 24 LINES AT CURRENT POINT IN FILE'
DISPLAY EQU *
ST R14,DISPSV14
MVC SAVBLKLB,BLKLABEL SAVE BLKLABEL MODE
BAL R14,UPDATE UPDATE SCREEN LINES IN EXTENDED STORAGE
BAL R14,CLEAR CLEAR DISPLAY AND RESET CURSOR
L R12,GLBCUR R12=A(CURRENT LB IN EXTENDED MEMORY)
LTR R12,R12
BNZ DISPOK
BAL R14,NEWFILE INITIALIZE EMPTY FILE
L R12,GLBCUR
DISPOK EQU *
SR R5,R5 RESET ROW
USING LB,R12
L R7,ASCB SCREEN TABLE
USING SCB,R7
DISPLINE EQU *
LTR R12,R12 IS LB ADDRESS GT 0
BZ DISPEXIT NO, GO EXIT
ST R12,SCBADDR SAVE ADDRESS OF LB
MVC SCBLB(LLB),LB MOVE CURRENT LINE TO SCB
MVI SCBMOD,FALSE SET MODIFY FALSE
SR R3,R3 SET STARTING COL.
BAL R14,PUTLINE
MVI BLKLABEL,FALSE TEMP TURN OFF BLKLABEL AFTER FIRST
NEXTLINE EQU * LINE TO ONLY MARK FIRST LINE
ST R5,LASTROW SET LAST ROW
ST R7,LASTSCB SET LAST SCB ADDR
LA R0,X'0100'
SVC KEYBOARD
STCM R0,4,KEY PUT LOW FLAGS BYTE IN KEY
TM KEY,X'40' IS THERE A KEY WAITING
BZ DISPEXIT YES, EXIT NOW WITH SHORT SCREEN
LA R5,X'100'(R5) INCR ROW
LA R6,X'00' RESET COL
L R12,SCBNEXT ADDRESS OF NEXT LB
LA R7,LSCB(R7) INCR SCREEN CONTROL BLOCK
CL R5,MAXROW
BNH DISPLINE
DISPEXIT EQU *
MVC BLKLABEL,SAVBLKLB RESTORE BLKLABEL MODE
LA R5,0 RESET ROW,COL TO 0,0
LA R6,0
L R7,ASCB RESET SCB ADDRESS
ZAP PCURLINE,PCUR
ZAP PCOL,=P'1'
BAL R14,SETCUR RESET CURSOR
L R14,DISPSV14
BR R14
TITLE 'SETCUR - SET CURSOR ON NEW DISPLAY'
SETCUR EQU *
ST R14,SETCSV14
CLC PCURLINE,PCURLAST
BE SCSKPREC
MVC PCURLAST,PCURLINE
MVC STATREC,=X'402020202120'
ED STATREC,PCURLINE
LA R3,STATREC
LA R4,L'STATREC
BAL R14,PUTSTAT
SCSKPREC EQU *
CLC PCOL,PCOLLAST
BE SCSKPCOL
MVC PCOLLAST,PCOL
MVC STATCOL,=X'40202120'
ED STATCOL,PCOL
LA R3,STATCOL
LA R4,L'STATCOL
BAL R14,PUTSTAT
SCSKPCOL EQU *
LA R15,0(R5,R6)
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
SVC VIDEO
L R14,SETCSV14
BR R14
TITLE 'NEWFILE - INITIALIZE NEW FILE IN MEMORY'
NEWFILE EQU *
ST R14,NEWFSV14
BAL R14,GETNEWLB
LTR R15,R15
BZ E03
L R12,ANEWLB
ST R12,GLBCUR
ST R12,GLBFIRST
ST R12,GLBLAST
ZAP PCUR,=P'1'
ZAP PLSTLINE,=P'1'
MVC WLBPREV,=A(0)
MVC WLBNEXT,=A(0)
MVC WLBLINE,=AL1(ASCCR,ASCLF)
BAL R14,CHKADDR
MVC LB(LLB),WLB INITIALIZE EMPTY LINE IN MEMORY
L R14,NEWFSV14
SR R15,R15
BR R14
TITLE 'PUTLINE - DISPLAY CURRENT LINE'
*
* R3 = STARTING COLUMN
*
* IF IN MARKING MODE, USE REVERSE VIDEO AND SET ENDING BLOCK
*
PUTLINE EQU *
ST R14,PUTLSV14
IC R0,ATTRIB
STC R0,ATTSAVE
CLI BLKLABEL,MARK
BNE PUTLINE1
MVC BLK2LB,SCBADDR UPDATE ENDING BLOCK
SLL R0,4
LR R1,R0
N R1,=X'00000070' BG=FG (TURN OFF HIGH INTENSITY/BLINK)
SRL R0,8
N R0,=X'00000007' FG=BG
OR R1,R0
STC R1,ATTRIB
OI ATTRIB,X'08' TURN ON INTENSITY FOR REVVERSE FG
PUTLINE1 EQU *
****************************************************************
*DISPCHAR EQU * *
* CLI 0(R2),ASCBLK IS IT END OF LINE *
* BL DSLNEXIT *
* MICRO LA R0,X'0200' AH=2 SET CURSOR *
* CODED LA R1,0 BH=0 PAGE *
* AS LA R15,0(R5,R3) DH=ROW,DL=COL *
* PC/370 SVC VIDEO *
* SVC 24 LA R0,X'0900' AH=9 *
* FOR LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE) *
* SPEED IC R1,ATTRIB BL=ATRIBUTE OF CHAR. *
* ON LA R14,1 CX=(COUNT OF CHAR TO WRITE) *
* MOST IC R0,0(R2) AL=CHAR *
* FREQ. SVC VIDEO DISPLAY CHAR *
* VIDEO LA R3,1(R3) INCR COL *
* FUNCT. LA R2,1(R2) INCR CHAR *
* B DISPCHAR REPEAT FOR LINE *
*DSLNEXIT EQU * *
****************************************************************
LA R2,SCBLINE(R3)
SR R1,R1
IC R1,ATTRIB PUT BH=0 AND BL=ATTIRBUTE IN R1
LA R15,0(R5,R3) PUT ROW AND COL IN R15
*****************************************************************
SVC PRINTTXT PRINT LINE AT (R2) AT (R15) ON SCREEN
*****************************************************************
STC R15,SCBCOL UPDATE ENDING COL. (NOTE SVC USES R15
SR R1,R1 INSETEAD OF R3)
IC R1,SCBCOL
LA R1,SCBLINE(R1)
MVC 0(2,R1),=AL1(ASCCR,ASCLF) ADD CR,LF
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,0(R5,R6) DH=ROW,DL=COL
SVC VIDEO
MVC ATTRIB,ATTSAVE RESET COLORS
L R14,PUTLSV14
BR R14
TITLE 'PUTMSG - DISPLAY 20 CHAR MSG AT R1'
PUTMSG EQU *
MVC STATMSG,0(R1)
LA R3,STATMSG
LA R4,L'STATMSG
B PUTSTAT
TITLE 'PUTSTAT - DISPLAY DATA ON STATUS LINE'
*
* R3 = START OF TEXT IN STATUS LINE
* R4 = LENGTH OF TEXT
*
PUTSTAT EQU *
ST R14,PUTSSV14
LR R1,R3
LR R2,R4
SVC EBCASC
LR R2,R3
SR R1,R1
STC R1,0(R3,R4) SET EOR FOR PRINTTXT
IC R1,ATTRIB
LR R15,R3
S R15,=A(STATLINE-STATRC0)
SVC PRINTTXT
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,0(R5,R6) DH=ROW,DL=COL
SVC VIDEO
L R14,PUTSSV14
BR R14
TITLE 'NEWSTAT - REFRESH STATUS LINE WITH CURRENT ATTRIBUTE'
NEWSTAT EQU *
ST R14,PUTSSV14
LA R2,STATLINE
LA R1,L'STATLINE
NEWSTAT1 EQU *
CLI 0(R2),ASCBLK
BNL NEWSTAT2
MVI 0(R2),ASCBLK CLEAR OUT INDIVIDUAL FIELD STOPS
NEWSTAT2 EQU *
LA R2,1(R2)
BCT R1,NEWSTAT1
SR R1,R1
IC R1,ATTRIB
LA R2,STATLINE
L R15,=A(STATRC0)
SVC PRINTTXT
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,0(R5,R6) DH=ROW,DL=COL
SVC VIDEO
L R14,PUTSSV14
BR R14
TITLE 'PUTPCT - UPDATE % OF MEMORY CAPACITY IN USE'
PUTPCT EQU *
ST R14,PPCTSV14
ZAP PWORK,PLSTLINE
CVB R1,PWORK
MH R1,=H'100'
SR R0,R0
D R0,FMAXLINE
CVD R1,PWORK
MVC STATPCT,=X'40202120'
ED STATPCT,PWORK+6
LA R3,STATPCT
LA R4,L'STATPCT+1
MVI STATPCT+L'STATPCT,C'%'
BAL R14,PUTSTAT
L R14,PPCTSV14
BR R14
TITLE 'CLEAR - CLEAR SCREEN AND SET CURSOR TO UPPER LEFT'
CLEAR EQU *
ST R14,CLRSV14
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,X'0000' DH=ROW,DL=COL
SVC VIDEO SET CURSOR TO UPPER LEFT CORNER
LA R0,X'0920' AH=10, AL=SPACE
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.
IC R1,ATTRIB
LA R14,24*80 CHARACTERS ON DATA LINES
SVC VIDEO CLEAR DATA LINES
L R14,CLRSV14
BR R14
TITLE 'GETKEY - GET NEXT KEY INPUT'
GETKEY EQU *
ST R14,GETKSV14
MVC LASTKEY,KEY SAVE LAST KEY
CLI KSMODE,KSREAD
BE KSGET
CHKNOW EQU *
LA R0,X'0100'
SVC KEYBOARD
STCM R0,4,KEY PUT LOW FLAGS BYTE IN KEY
TM KEY,X'40' IS THERE A KEY WAITING
BZ GETNOW YES, GO GET KEY NOW
BAL R14,KEYSTATS NO, GO UPDATE KEY STATUS FIRST
B CHKNOW
GETNOW EQU *
LA R0,X'0000'
SVC KEYBOARD GET KEY FROM KEYBOARD BIA BIOS
STC R0,KEY
CLI KEY,X'00' IS IT NULL CODE
BE KEYEXT YES, GET EXTENDED CODE
CLI KEY,X'80' IS IT ASCII 0-127
BL KEYOK YES, OK
MVI KEY,X'00' NO, MAKE IT NULL
B KEYOK
KEYEXT EQU *
STCM R0,2,KEY STORE AH EXTENDED CODE
OI KEY,X'80' FORCE EXTENDED CODES TO 128+
KEYOK EQU *
CLI KSMODE,KSWRITE IS KEYBOARD FILE BEING WRITTEN
BNE GETKEXIT NO, EXIT
KSPUT EQU * YES, PUT KEY
L R1,KSNEXT
MVC 0(1,R1),KEY MOVE KEY TO KS OUTPUT RECORD
LA R1,1(R1)
ST R1,KSNEXT
CL R1,=A(KSRECEND)
BL GETKEXIT
LA R1,KSREC
ST R1,KSNEXT RESET NEXT POINTER
LA R2,SYSUT2
SVC PUT WRITE KS RECORD
B GETKEXIT
KSGET EQU *
L R1,KSNEXT
LA R1,1(R1)
ST R1,KSNEXT
CL R1,=A(KSRECEND)
BL KSGETOK
LA R1,KSREC
ST R1,KSNEXT
LA R2,SYSUT2
SVC GET READ KS RECORD
KSGETOK EQU *
MVC KEY,0(R1)
GETKEXIT EQU *
L R14,GETKSV14
BR R14
TITLE 'AUDITSCB - AUDIT SCB'S AGAINST LB'S'
AUDITSCB EQU *
CLI AUDIT,TRUE
BNER R14
STM R0,R3,SAVER0R3
LA R0,0 ERR 0
LTR R5,R5
BM AUDITBUG ROW LT 0
CL R5,MAXROW
BH AUDITBUG ROW GT 23
LA R0,10 ERR 10
LA R1,LASTROW
LA R2,LASTSCB
CL R5,LASTROW
BH AUDITBUG ROW GT LASTROW
CL R7,LASTSCB
BH AUDITBUG ASCB GT LASTSCB
LA R0,11 ERR 11
LR R1,R5
SRL R1,8
MH R1,=AL2(LSCB)
A R1,ASCB
CLR R1,R7 ROW NE ASCB
BNE AUDITBUG
L R1,ASCB
SR R2,R2
AUDITL EQU *
L R12,SCBADDR-SCB(R1)
MVC WLB(8),LB
CLC SCBLB-SCB(8,R1),WLB CHECK LB POINTERS
LA R0,1 ERR 1
BNE AUDITBUG SCB PREV/NEXT NE LB PREV/NEXT
LR R3,R1
LA R2,ROWINC(R2)
LA R1,LSCB(R1)
CL R2,LASTROW
BH AUDITE
CLC SCBNEXT-SCB(4,R3),SCBADDR-SCB(R1)
LA R0,2 ERR 2
BNE AUDITBUG SCBNEXT EQ SCBADDR OF NEXT
CLC SCBPREV-SCB(4,R1),SCBADDR-SCB(R3)
BNE AUDITBUG SCBPREV EQ SCBADDR OF PREV
B AUDITL
AUDITE EQU *
LM R0,R3,SAVER0R3
BR R14
AUDITBUG EQU * ENTER PC/370 DEBUG WITH ERR IN R0
SVC TRACE
DC C'BUG '
B *
TITLE 'AUDITMS - AUDIT MAIN STORAGE LBS'
AUDITMS EQU *
CLI AUDIT,TRUE
BNER R14
STM R0,R3,SAVER0R3
ZAP PCHKLINE,=P'0'
MVC WLBADDR,GLBFIRST
L R12,WLBADDR
LTR R12,R12
BZ AUDITMSE
MVC WLB(LLB),LB
LA R0,3 ERR 3
LA R1,WLBADDR
CLC WLBPREV,=A(0)
BNE AUDITBUG FIRST LBPREV EQ 0
LA R0,4 ERR 4
LA R3,TLBADDR
AUDITMSL EQU *
AP PCHKLINE,=P'1'
MVC TLBADDR,WLBNEXT
L R12,TLBADDR
LTR R12,R12
BZ AUDITMSE
MVC TLB(LLB),LB
CLC WLBADDR,TLBPREV
BNE AUDITBUG LP(I) EQ LPREV(I+1)
MVC WLBADDR,TLBADDR
MVC WLB(LLB),TLB
B AUDITMSL
AUDITMSE EQU *
LA R0,5 ERR 5
L R1,WLBADDR
L R3,GLBLAST
CLC WLBADDR,GLBLAST
BNE AUDITBUG GLBLAST EQ LP(LAST)
LA R0,6 ERR 6
LA R1,PCHKLINE
LA R3,PLSTLINE
CP PCHKLINE,PLSTLINE
BNE AUDITBUG PLSTLINE EQ LB COUNT
LM R0,R3,SAVER0R3
BR R14
TITLE 'TERMKSF - FLUSH AND CLOSE KSF FILE IF ACTIVE'
TERMKSF EQU *
ST R14,TERMSV14
CLI KSMODE,KSOFF IS KEYBOARD FILE IN USE
BE TERMKSFE NO, EXIT NOW
CLI KSMODE,KSWRITE IS IT WRITE
BNE TERMKSFC NO, GO CLOSE IT
L R1,KSNEXT
CL R1,=A(KSREC) IS THERE DATA IN LAST RECORD
BE TERMKSFC NO, GO CLOSE IT
LA R1,KSREC
LA R2,SYSUT2
SVC PUT YES, WRITE LAST KS RECORD
TERMKSFC EQU *
LA R2,SYSUT2
SVC CLOSE CLOSE KS FILE
TERMKSFE EQU *
L R14,TERMSV14
BR R14
TITLE 'KEYSTATS - UPDATE CAPS, INSERT, NUMLOCK STATUS'
KEYSTATS EQU *
ST R14,KEYSSV14
LA R0,X'0200' AH=2 RETURN SHIFT STATUS
SVC KEYBOARD READ SHIFT STATUS INTO AL (TECH. A-26)
******
*
* NOTE INS STATE IS TOGGLED BY KEY ROUTINE ALWAYS STARTING IN OFF
* STATE RATHER THAN USING MS-DOS TOGGLED STATUS WHICH MAY OR MAY
* NOT BE OFF AT START OF PROGRAM. (USER MAY CHANGE OPTION. IF YOU
* DO REMEMBER TO DISABLE TOGGLE IN KRINS ROUTINE.)
*
* STC R0,KBINS
* NI KBINS,INSSTATE
*
*****
STC R0,KBCAP SET CAP STATUS
NI KBCAP,CAPSTATE
STC R0,KBNUM SET NUM STATUS
NI KBNUM,NUMSTATE
KEYSINS EQU *
CLC KBINS,KBINSLST
BE KEYSCAP
CLI KBINS,INSSTATE
MVC STATINS,=C'INS'
BE KEYSINSU
MVC STATINS,=C' '
KEYSINSU EQU *
MVC KBINSLST,KBINS
LA R3,STATINS
LA R4,L'STATINS
BAL R14,PUTSTAT
KEYSCAP EQU *
CLC KBCAP,KBCAPLST
BE KEYSNUM
CLI KBCAP,CAPSTATE
MVI KBCAP,CAPSTATE
MVC STATCAP,=C'CAP'
BE KEYSCAPU
MVI KBCAP,0
MVC STATCAP,=C' '
KEYSCAPU EQU *
MVC KBCAPLST,KBCAP
LA R3,STATCAP
LA R4,L'STATCAP
BAL R14,PUTSTAT
KEYSNUM EQU *
CLC KBNUM,KBNUMLST
BE KEYSEXIT
CLI KBNUM,NUMSTATE
MVI KBNUM,NUMSTATE
MVC STATNUM,=C'NUM'
BE KEYSNUMU
MVI KBNUM,0
MVC STATNUM,=C' '
KEYSNUMU EQU *
MVC KBNUMLST,KBNUM
LA R3,STATNUM
LA R4,L'STATNUM
BAL R14,PUTSTAT
KEYSEXIT EQU *
L R14,KEYSSV14
BR R14
TITLE 'KR - KEY CONTROL ROUTINES'
*
* ALL ROUTINES STARTING WITH KR..... ARE ACCESSED VIA BALR FROM EDIT
* BASED ON USE OF EXTENDED ASCII KEYBOARD INPUT BYTE USED AS INDEX
* INTO KEYTAB TO OFFSET TO KRTAB ADDRESS TABLE POINTER TO KR ROUTINE.
* THIS IDEXING SCEME CAN HANDLE UP TO 63 KR ROUTINES.
*
KRUND EQU * PROCESS UNDEFINED KEY
BR R14
KRCHAR EQU * PROCESS ASCII CHARACTER
ST R14,KRSV14
BAL R14,KRSETCHR
LA R6,1(R6) INCR COL
AP PCOL,=P'1'
MVC STATCOL,=X'40202020'
ED STATCOL,PCOL
LA R3,STATCOL+2
LA R4,2
BAL R14,PUTSTAT
MVC PCOLLAST,PCOL
CH R6,=H'80' WRAP IF END OF LINE
BL KRCHARS2
LA R6,0 RESET COL
ZAP PCOL,=P'1'
LA R5,ROWINC(R5) INCR ROW
AP PCURLINE,=P'1'
LA R7,LSCB(R7) INCR SCB LINE
CL R5,LASTROW WRAP IF LAST LINE
BNH KRCHARS1
LA R5,0 RESET ROW
ZAP PCURLINE,PCUR
L R7,ASCB RESET SCB
KRCHARS1 EQU * UPDATE CURSOR ON SCREEN
BAL R14,SETCUR
KRCHARS2 EQU *
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,0(R5,R6) DH=ROW,DL=COL
SVC VIDEO
L R14,KRSV14
BR R14
KRSETCHR EQU * STORE KEY AT CURSOR
ST R14,SCHRSV14
MVI SCBMOD,TRUE SET MOD SWITCH FOR CURRENT LINE
MVI SCRMOD,TRUE SET MOD SWITCH FOR CURRENT SCREEN
CLM R6,1,SCBCOL IS NEW CHAR PAST END OF LINE
BL KRCHARCI NO, GO CHECK INSERT MODE
SR R2,R2
IC R2,SCBCOL R2 = OLD COL
LR R1,R6
SR R1,R2
LA R2,SCBLINE(R2)
MVI 0(R2),ASCBLK INIT PAD
EX R1,MVCPAD EXTEND PAD TO NEW COLUMN
LA R1,1(R6)
STC R1,SCBCOL SET NEW ENDING COL
LA R2,SCBLINE(R1)
MVC 0(2,R2),=AL1(ASCCR,ASCLF) ADD CR,NL
KRCHAROK EQU *
LA R0,X'0900' AH=9
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE)
IC R1,ATTRIB BL=ATRIBUTE OF CHAR.
LA R14,1 CX=(COUNT OF CHAR TO WRITE)
IC R0,KEY AL=CHAR.
STC R0,SCBLINE(R6) STORE CHARACTER IN SCREEN TEXT
SVC VIDEO DISPLAY ASCII CHAR
L R14,SCHRSV14
BR R14
MVCPAD MVC 1(0,R2),0(R2) PAD TO NEW COLUMN
KRCHARCI EQU * CHECK INSERT MODE
CLI KBINS,INSSTATE
BNE KRCHAROK NO, GO STORE CHAR AND EXIT
CLM R6,1,=AL1(79) IS THIS LAST CHAR
BE KRCHAROK YES, GO STORE CHAR AND EXIT
LA R2,SCBLINE(R6)
SR R1,R1
IC R1,SCBCOL
LA R1,1(R1)
STC R1,SCBCOL UPDATE ENDING COL
SR R1,R6 R1 = LENGTH OF TEXT + 2 - 1
EX R1,INSMVC1 SAVE TEXT TO BE SHIFTED
EX R1,INSMVC2 MOVE TEXT BACK SHIFTED RIGHT
IC R2,KEY
STC R2,SCBLINE(R6) STORE CHARACTER IN SCREEN TEXT
LR R3,R6
BAL R14,PUTLINE UPDATE SHIFTED LINE
L R14,SCHRSV14
BR R14
INSMVC1 MVC WLBLINE(0),0(R2) MOVE TEXT TO BE SHIFTED RIGHT
INSMVC2 MVC 1(0,R2),WLBLINE MOVE TEXT BACK SHIFTED RIGHT 1
KRESC EQU * PROCESS ESCAPE KEY
MVI EOJ,TRUE
BR R14
KRPGUP EQU * PROCESS PAGE UP KEY
ST R14,KRSV14
L R12,GLBCUR
USING LB,R12
LA R3,12
KRPGUPL EQU *
MVC WLBPREV,LBPREV
L R12,WLBPREV
LTR R12,R12
BZ KRPGUPE
ST R12,GLBCUR
SP PCUR,=P'1'
BCT R3,KRPGUPL
KRPGUPE EQU *
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KRPGDN EQU * PROCESS PAGE DOWN KEY
ST R14,KRSV14
L R12,GLBCUR
LA R3,12
KRPGDNL EQU *
MVC WLBNEXT,LBNEXT
L R12,WLBNEXT
LTR R12,R12
BZ KRPGDNE
ST R12,GLBCUR
AP PCUR,=P'1'
BCT R3,KRPGDNL
KRPGDNE EQU *
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KRF1 EQU * F1 FOR HELP SCREEN 1
ST R14,KRSV14
BAL R14,CLEAR
LA R2,F1SC
L R3,=A(F1SCEND)
BAL R14,HELPSCRN
BAL R14,GETKEY WAIT FOR ANY KEY
L R14,KRSV14
CLI KEY,ASCF2
BE KRF2 SWITCH HELP SCREEN WITHOUT DISPLAY
KRF1COM EQU *
LA R15,KRALTF1
CLI KEY,ASCALTF1
BE KRF1WAIT
LA R15,KRALTF2
CLI KEY,ASCALTF2
BNE KRF1SKPW
KRF1WAIT EQU *
BALR R14,R15 GO WAIT FOR ALT-F1 OR F2
KRF1SKPW EQU * NOW CLEAR HELP SCREEN
BAL R14,DISPLAY
L R14,KRSV14
BR R14
HELPSCRN EQU * DISPLAY HELP SCREEN
LA R4,0
HELPLOOP EQU *
ST R14,HELPSV14
SR R1,R1
IC R1,ATTRIB
LR R15,R4
SVC PRINTTXT
LA R4,ROWINC(R4)
CLR R2,R3
BL HELPLOOP
L R14,HELPSV14
BR R14
KRF2 EQU * F2 FOR HELP SCREEN 2
ST R14,KRSV14
BAL R14,CLEAR
L R2,=A(F2SC)
L R3,=A(F2SCEND)
BAL R14,HELPSCRN
BAL R14,GETKEY WAIT FOR ANY KEY
L R14,KRSV14
CLI KEY,ASCF1
BE KRF1 SWITCH HELP SCREEN WITHOUT DISPLAY
B KRF1COM
KRUP EQU * CURSOR UP
ST R14,KRSV14
MVI DIRNEW,DIRUP
BAL R14,KRCHKBOX
LTR R5,R5
BNZ KRUPROW
L R12,SCBPREV
LTR R12,R12
BZ KRUPEXIT
ST R12,GLBCUR
SP PCUR,=P'1'
ZAP PCURLINE,PCUR
BAL R14,CHKMARK
BAL R14,SCRLDOWN
L R12,GLBCUR
MVC SCBLB(LLB),LB MOVE NEW CURRENT LB TO FIRST LINE
ST R12,SCBADDR
ST R12,GLBCUR
SR R3,R3
BAL R14,PUTLINE
MVI SCBMOD,FALSE
B KRUPEXIT
KRUPROW EQU *
BAL R14,CHKMARK
SP PCURLINE,=P'1'
SH R5,=AL2(ROWINC)
SH R7,=AL2(LSCB)
KRUPEXIT EQU *
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRDOWN EQU * CURSOR DOWN
ST R14,KRSV14
MVI DIRNEW,DIRDOWN
BAL R14,KRCHKBOX
CL R5,LASTROW
BL KRDOWNRW
L R12,SCBNEXT
LTR R12,R12 IS THERE A NEXT LINE
BZ KRDOWNXT NO, EXIT NOW
CL R5,MAXROW IS THERE ANOTHER LINE ON SCREEN
BL KRDOWNAR YES, GO ADD IT
ST R12,WLBNEXT
SR R3,R3
LR R4,R5
L R7,ASCB
BAL R14,SCRLUP NO, SCROLL SCREEN UP
L R7,ASCB
MVC GLBCUR,SCBADDR UPDATE SCREEN CURRENCY
AP PCUR,=P'1'
L R7,MAXSCB
L R12,WLBNEXT
KRDOWNNR EQU * UPDATE NEW ROW
MVC SCBLB(LLB),LB
ST R12,SCBADDR
SR R3,R3
BAL R14,PUTLINE
MVI SCBMOD,FALSE
AP PCURLINE,=P'1'
B KRDOWNXT
KRDOWNAR EQU *
AH R5,=AL2(ROWINC)
AH R7,=AL2(LSCB)
ST R5,LASTROW
ST R7,LASTSCB
B KRDOWNNR
KRDOWNRW EQU * MOVE CURSOR DOWN ROW
AP PCURLINE,=P'1'
AH R5,=AL2(ROWINC)
AH R7,=AL2(LSCB)
KRDOWNXT EQU *
BAL R14,SETCUR
BAL R14,CHKMARK
L R14,KRSV14
BR R14
KRLEFT EQU * CURSOR LEFT
ST R14,KRSV14
MVI DIRNEW,DIRLEFT
BAL R14,KRCHKBOX
BCTR R6,0
SP PCOL,=P'1'
BNZ KRLEFT1
LA R6,79
ZAP PCOL,=P'80'
KRLEFT1 EQU *
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRRIGHT EQU * CURSOR RIGHT
ST R14,KRSV14
MVI DIRNEW,DIRRIGHT
BAL R14,KRCHKBOX
AP PCOL,=P'1'
LA R6,1(R6)
CH R6,=AL2(79)
BNH KRRIGHT1
ZAP PCOL,=P'1'
LA R6,0
KRRIGHT1 EQU *
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRCHKBOX EQU * SET BOX CHAR AT CURSOR IF BOX MODE
SR R1,R1
IC R1,DIRLAST
MVC DIRLAST,DIRNEW
CLI BOX,TRUE
BNER R14
ST R14,KRBXSV14
IC R0,REVDIR(R1)
STC R0,REVLAST SAVE REVERSE OF LAST DIRECTION
SLL R1,2
LA R2,DIRTAB(R1) SELECT TABLE ROW BASED ON 4*DIRLAST
IC R1,DIRNEW
IC R1,0(R1,R2) R1 = DIRECTION KEY INDEX
L R2,BOXSETA
IC R1,0(R1,R2) R1 = KEY FROM INDEXED SET
STC R1,KEY SELECT KEY FROM BOXSET(NEWDIR,OLDDIR)
CLI CONNECT,TRUE
BNE KRCHKBOK KEY OK IF NOT IN CONNECT MODE
CLM R6,1,SCBCOL
BNL KRCHKBOK KEY OK IF NO PREVIOUS CHARACTER AT CURSOR
SR R0,R0
IC R0,SCBLINE(R6)
SH R0,=AL2(179) R0 = GRAPHIC CHAR. INDEX
BM KRCHKBOK KEY OK IF CHAR AT CURSOR < FIRST GRAPHIC
CLM R0,1,=AL1(218-179)
BH KRCHKBOK KEY OK IF CHAR AT CURSOR > LAST GRAPHIC
CL R2,=A(BOXSET1) IS CURRENT BOX SET SINGLE LINE
BNE KRCHKBS2
LA R2,BOXCON R2 = BOXCON( SINGLE BOX SET)
B KRCHKBCN
KRCHKBS2 EQU *
CL R2,=A(BOXSET2) IS CURRENT BOX SET DOUBLE LINE
BNE KRCHKBOK NO, KEY OK AS IS
LA R2,BOXCON+4 R2 = BOXCON( DOUBLE BOX SET)
KRCHKBCN EQU * USE BOX CONNECT TABLE TO CONNECT NEW DIR
SLL R0,3
LR R1,R2
AR R1,R0 R1 = A(BOXCON(S/D SET, OLD CHAR))
SR R0,R0
IC R0,DIRNEW
AR R1,R0 R1 = A(BOXCON(S/D SET, OLD CHAR, NEWDIR))
IC R0,0(R1)
SH R0,=AL2(179) CONVERT NEW KEY TO INDEX
SLL R0,3 REPEAT PROCESS TO CONNECT OLD DIR LINE
LR R1,R2
AR R1,R0
SR R0,R0
IC R0,REVLAST USE REVERSE OF OLD DIR TO SHARE BOXCON
AR R1,R0
IC R0,0(R1)
STC R0,KEY SET NEW GRAPHIC CHAR WITH CONNECTIONS
KRCHKBOK EQU *
BAL R14,KRSETCHR STORE KEY AT CURSOR
KRCHKBX1 EQU *
LA R0,X'0100'
SVC KEYBOARD
STCM R0,4,PWORK
TM PWORK,X'40' IS THERE ANOTHER KEY WAITING
BNZ KRCHKBX2 NO, PROCEED
LA R0,X'0000'
SVC KEYBOARD YES, FLUSH KEY AND TRY AGAIN
B KRCHKBX1
KRCHKBX2 EQU *
L R14,KRBXSV14
BR R14
KRINS EQU * INSERT KEY TOGGLED - UPDATE STATUS LINE
ST R14,KRSV14
XI KBINS,INSSTATE TOGGLE INS (IGNORE INS STATUS LINE)
BAL R14,KEYSTATS
L R14,KRSV14
BR R14
KRDEL EQU * DELETE CHAR OR BLOCK VIA DEL KEY
ST R14,KRSV14
CLI BLKLABEL,FALSE IS THERE A LABELED BLOCK
BNE KRDELBLK YES, GO DELETE IT
KRDELCHR EQU *
CLM R6,1,SCBCOL IS CURSOR PAST END OF LINE
BNLR R14 YES, IGNORE DELETE KEY
MVI SCBMOD,TRUE LINE MOD
MVI SCRMOD,TRUE SCREEN MOD
SR R1,R1
IC R1,SCBCOL
BCTR R1,0
STC R1,SCBCOL UPDATE ENDING COL
LR R4,R1 SAVE COL TO BLANK ON SCREEN
LA R1,2(R1)
SR R1,R6
LA R2,SCBLINE(R6)
EX R1,MVCLEFT SHIFT TEXT ONLY TO OVERLAY DEL CHAR
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LA R15,0(R5,R4) DH=ROW,DL=COL OLD LAST CHAR
SVC VIDEO UPDATE CURSOR
LA R0,X'0920' AH=9, AL= ASCII BLANK
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.
IC R1,ATTRIB BL=ATRIBUTE OF CHAR.
LA R14,1 CX=(COUNT OF CHAR TO WRITE)
SVC VIDEO DISPLAY CHAR
LR R3,R6
BAL R14,PUTLINE REFRESH LINE TO NEW END OF LINE
BAL R14,SETCUR
L R14,KRSV14
BR R14
MVCLEFT MVC 0(0,R2),1(R2)
KRCTLKY EQU * DELETE LABELED BLOCK VIA CTL-K Y
ST R14,KRSV14
CLI BLKLABEL,FALSE
BER R14
KRDELBLK EQU * DELETE LABELED BLOCK
LA R1,=CL20'DELETE BLOCK'
BAL R14,PUTMSG
MVI CURDEL,FALSE RESET CURRENT LB DELETE SWITCH
ZAP PBLKCNT,=P'0'
L R12,BLK1LB
KRDELBK1 EQU * CHECK IF CURRENT LB IN BLOCK
AP PBLKCNT,=P'1'
CL R12,GLBCUR IS CURRENT LINE BEING DELETED
BNE KRDELBKC
MVI CURDEL,TRUE YES, SET SWITCH
KRDELBKC EQU *
CL R12,BLK2LB
BE KRDELBK2 OK, GO DELETE BLOCK
MVC WLBNEXT,LBNEXT GET NEXT LB TO DUP.
L R12,WLBNEXT
LTR R12,R12
BNZ KRDELBK1
LA R1,=CL20'BLOCK NOT FOUND'
BAL R14,PUTMSG
B KRDEXIT
KRDELBK2 EQU * OK TO DELETE BLOCK
MVI SCRMOD,TRUE SET SCREEN MOD
L R12,BLK1LB
MVC WLBPREV,LBPREV GET PREV. FROM FIRST BLOCK
L R12,BLK2LB
BAL R14,CHKADDR
MVC WLBNEXT,LBNEXT GET NEXT FROM LAST BLOCK
MVC LBNEXT,AFREELB CHAIN FREE QUEUE TO LAST
MVC AFREELB,BLK1LB SET FREE QUEUE TO FIRST
L R12,WLBPREV
LTR R12,R12
BZ KRDELFST GO SET NEW FIRST LB
BAL R14,CHKADDR
MVC LBNEXT,WLBNEXT CHAIN PREV TO NEXT
B KRDELCKL
KRDELFST EQU *
MVC GLBFIRST,WLBNEXT RESET FIRST PAST BLOCK
KRDELCKL EQU *
L R12,WLBNEXT
LTR R12,R12
BZ KRDELLST
SP PLSTLINE,PBLKCNT
BAL R14,CHKADDR
MVC LBPREV,WLBPREV CHAIN NEXT TO PREV
B KRDELCUR
KRDELLST EQU *
MVC GLBLAST,WLBPREV RESET LAST TO PREV
ZAP PLSTLINE,PCURBLK1
SP PLSTLINE,=P'1'
KRDELCUR EQU *
CLI CURDEL,TRUE IS CURRENT LB DELETED
BNE KRDEXIT NO, EXIT WITH DISPLAY REQ.
ZAP PCUR,PCURBLK1
SP PCUR,=P'1'
MVC GLBCUR,WLBPREV YES, TRY PREV
CLC GLBCUR,=A(0) IS PREV ZERO
BNE KRDEXIT NO, EXIT
ZAP PCUR,=P'1'
MVC GLBCUR,WLBNEXT YES, TRY NEXT
KRDEXIT EQU *
MVI BLKLABEL,FALSE RESET LABEL
MVC STATBLK,=C' '
LA R3,STATBLK
LA R4,L'STATBLK
BAL R14,PUTSTAT
BAL R14,AUDITMS
BAL R14,PUTPCT
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KRCR EQU * CARRIAGE RETURN (ENTER)
ST R14,KRCRSV14
CLI KBINS,INSSTATE INSERT MODE
BE KRINSLN YES GO INSERT LINE
BAL R14,KRDOWN NO, MOVE DOWN LINE
B KRINSEXT EXIT
KRINSLN EQU * INSERT LINE
L R12,SCBADDR
BAL R14,GETNEWLB GET FREE LB IN EXT. MEMORY
L R14,KRCRSV14
LTR R15,R15
BNZR R14 IGNORE REQUEST IF NO ROOM
AP PLSTLINE,=P'1'
MVI FILEMOD,TRUE SET FILE CHANGE
MVI SCRMOD,TRUE SET SCREEN MODE
LTR R6,R6
BNZ KRINSAFT IF NOT COL 0, INSERT AFTER CURRENT LINE
L R12,SCBPREV
LTR R12,R12
BNZ KRINSPRE IF NOT FIRST, INSERT AFTER PREV. LINE
KRINSFST EQU * ELSE MAKE NEW LINE FIRST LINE
MVC GLBFIRST,ANEWLB RESET FIRST LB POINTER
MVC GLBCUR,ANEWLB RESET CURRENT LB POINTER
MVC WLBPREV,=A(0) SET NO PREV.
MVC WLBNEXT,SCBADDR CHAIN OLD CURRENT TO NEW
BAL R14,SCRLDOWN SCROLL DOWN AND ADJUST SCB'S
BAL R14,KRINSWLB CREATE NULL LB AND UPDATE SCB'S
B KRINSEXT
KRINSPRE EQU *
LTR R5,R5 IS THIS FIRST LINE
BNZ KRINSSKC NO, LEAVE CURRENT LINE ON SCREEN
SP PCUR,=P'1'
SP PCURLINE,=P'1'
MVC GLBCUR,SCBPREV YES, MOVE PREV. LINE TO TOP LINE
MVC WLBPREV,SCBPREV CHAIN NEW LINE TO PREV. LB
MVC WLBNEXT,SCBADDR
BAL R14,SCRLDOWN MOVE FIRST TWO LINES DOWN
BAL R14,SCRLDOWN
L R12,GLBCUR
MVC SCBLB(LLB),LB
ST R12,SCBADDR
SR R3,R3
BAL R14,PUTLINE
MVI SCBMOD,FALSE
LA R5,ROWINC(R5) RESET CURSOR TO SECOND LINE
LA R7,LSCB(R7)
BAL R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
B KRINSEXT
KRINSSKC EQU * LINK BETWEEN PREV AND CURRENT
MVC WLBPREV,SCBPREV
MVC WLBNEXT,SCBADDR
BAL R14,SCRLDOWN SCROLL DOWN
BAL R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
B KRINSEXT
KRINSAFT EQU * LINK BETWEEN CURRENT AND NEXT
CLC SCBNEXT,=A(0) IS NEW LINE AT END
BNE KRINSANL NO, SKIP UPDATE TO LAST
MVC GLBLAST,ANEWLB
KRINSANL EQU *
MVC WLBPREV,SCBADDR
MVC WLBNEXT,SCBNEXT
CL R5,MAXROW
BL KRINSASD IF NOT LAST ROW, SCROLL DOWN
KRINSASU EQU * SCROLL UP FOR NEW LINE ON LAST ROW
LA R3,0
LR R4,R5
ST R7,SAVESCB
L R7,ASCB
BAL R14,SCRLUP IF LAST LINE, SCROLL UP
L R7,SAVESCB
AP PCURLINE,=P'1'
BAL R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
B KRINSEXT
KRINSASD EQU * SCROLL DOWN AND INSERT NEW ROW
LA R5,ROWINC(R5) MOVE TO NEXT ROW
AP PCURLINE,=P'1'
LA R7,LSCB(R7)
BAL R14,SCRLDOWN
BAL R14,KRINSWLB
KRINSEXT EQU *
LA R6,0
ZAP PCOL,=P'1'
CLI HTMODE,TRUE
BNE KRSKPHT
BAL R14,KRHT TAB
KRSKPHT EQU *
BAL R14,PUTPCT
BAL R14,SETCUR RESET CURSOR ON NEW INSERTED LINE
CLI KBINS,INSSTATE IS INSERT ON
BNE KRSKPDN NO, SKIP EXTRA DOWN
CLC LASTKEY,KEY WAS LAST KEY ALSO CR TO INSERT
BNE KRSKPDN YES, MOVE CURSOR DOWN TO PREV INSERT
BAL R14,KRDOWN
KRSKPDN EQU *
BAL R14,AUDITMS
L R14,KRCRSV14
BR R14
TITLE 'KRINSWLB - CREATE NULL WLB AND UPDATE LB'S AND SCB'
KRINSWLB EQU *
ST R14,INSCSV14
MVC WLBLINE,=AL1(ASCCR,ASCLF) SET TEXT TO NULL LINE
MVC SCBADDR,ANEWLB
MVC SCBLB,WLB MOVE NEW LB INTO CURRENT SCB
MVI SCBCOL,0
MVI SCBMOD,FALSE
L R12,ANEWLB
BAL R14,CHKADDR
MVC LB(LLB),WLB INIT NEW LB
KRINSWLN EQU *
L R12,WLBNEXT
LTR R12,R12
BZ KRINSWLP
BAL R14,CHKADDR
MVC LBPREV,ANEWLB CHAIN NEXT LB BACK TO NEW LB
LA R1,LSCB(R7)
CL R1,MAXSCB IS THERE A NEXT SCB
BH KRINSWLP
MVC SCBPREV-SCB(4,R1),ANEWLB ALSO UPDATE NEXT SCB
KRINSWLP EQU *
L R12,WLBPREV
LTR R12,R12
BZ KRINSWLE
BAL R14,CHKADDR
MVC LBNEXT,ANEWLB CHAIN PREV LB TO NEW LB
LR R1,R7
SH R1,=AL2(LSCB)
CL R1,ASCB IS THERE A PREV SCB
BL KRINSWLE
MVC SCBNEXT-SCB(4,R1),ANEWLB ALSO UPDATE PREV SCB
KRINSWLE EQU *
L R14,INSCSV14
BR R14
TITLE 'SCRLDOWN - SCROLL SCREEN DOWN 1 LINE'
*
* SCROLL SCREEN DOWN FROM CURRENT ROW TO MAXROW
*
SCRLDOWN EQU *
ST R14,SCRLSV14
CL R5,MAXROW IS CURRENT ROW = LAST ROW
BE SCRLDWN1 YES, GO CLEAR LINE
LA R0,X'0701' SCROLL DOWN 1 LINE
LR R14,R5 CX = STARTING ROW,COL
L R15,=A(SCRLEND) DX = ENDING ROW,COL
LA R1,0
ICM R1,B'0010',ATTRIB
SVC VIDEO
L R1,MAXSCB
B SCRLDWNS
SCRLDWN1 EQU *
LR R3,R5
BAL R14,CLRLINE
SCRLDWNS EQU *
CLC LASTROW,MAXROW IS LAST ROW ACTIVE
BL SCRLSKPU NO, IGNORE
CLI SCBMOD-SCB(R1),TRUE HAS IT CHANGED
BNE SCRLSKPU NO, THROW AWAY
L R12,SCBADDR-SCB(R1) YES, UPDATE MEMORY
BAL R14,CHKADDR
MVC LB(LLB),SCBLB-SCB(R1) SAVE UPDATED LAST LINE
SCRLSKPU EQU *
L R2,=A(22*ROWINC) ROW BEING MOVED DOWN
SH R1,=AL2(LSCB)
SCRLSHFT EQU *
CR R2,R5
BL SCRLUPLT
MVC LSCB(LSCB,R1),0(R1) MOVE SCB DOWN ONE
SH R1,=AL2(LSCB)
SH R2,=AL2(ROWINC)
B SCRLSHFT
SCRLUPLT EQU * UPDATE LAST ROW
L R1,LASTROW
LA R1,ROWINC(R1)
CL R1,MAXROW
BH SCRLEXIT
ST R1,LASTROW
L R1,LASTSCB
LA R1,LSCB(R1)
ST R1,LASTSCB
SCRLEXIT EQU *
L R14,SCRLSV14
BR R14
TITLE 'SCRLUP - SCROLL SCREEN UP 1 LINE'
*
* R3 - STARTING ROW
* R4 - ENDING ROW
* R7 - STARTING SCB
*
SCRLUP EQU *
ST R14,SCRLSV14
CLR R3,R4 DON'T SCROLL 1 LINE
BE SCRLUP1
LA R0,X'0601' SCROLL DOWN 1 LINE
LA R14,0(R3) CX = STARTING ROW,COL
LA R15,79(R4) DX = ENDING ROW,COL
LA R1,0
ICM R1,B'0010',ATTRIB
SVC VIDEO
B SCRLUPSS
SCRLUP1 EQU *
BAL R14,CLRLINE CLEAR ROW R3 ON SCREEN
SCRLUPSS EQU *
CLI SCBMOD,TRUE HAS IT CHANGED
BNE SCRLUPSK NO, THROW AWAY
L R12,SCBADDR YES, UPDATE MEMORY
BAL R14,CHKADDR
MVC LB(LLB),SCBLB SAVE UPDATED FIRST LINE
SCRLUPSK EQU *
LA R2,ROWINC(R3) ROW BEING MOVED UP
SCRLUPSH EQU *
CR R2,R4
BH SCRLUPEX
MVC 0(LSCB,R7),LSCB(R7) MOVE SCB UP ONE
LA R7,LSCB(R7)
LA R2,ROWINC(R2)
B SCRLUPSH
SCRLUPEX EQU *
L R14,SCRLSV14
BR R14
TITLE 'CLRLINE - CLEAR ROW R3 ON SCREEN'
CLRLINE EQU *
ST R14,CLRLSV14
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
LR R15,R3 DH=ROW,DL=COL
SVC VIDEO SET CURSOR TO UPPER LEFT CORNER
LA R0,X'0920' AH=10, AL=SPACE
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.
IC R1,ATTRIB
LA R14,80 CHARACTERS ON DATA LINES
SVC VIDEO CLEAR DATA LINES
L R14,CLRLSV14
BR R14
KRHOME EQU * HOME
ST R14,KRSV14
MVC GLBCUR,GLBFIRST
ZAP PCUR,=P'1'
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KREND EQU * END
MVC GLBCUR,GLBLAST
ZAP PCUR,PLSTLINE
B KRPGUP
KRSHF6 EQU * SHIFT F6 (DELETE LINE)
ST R14,KRSV14
SP PLSTLINE,=P'1'
MVI FILEMOD,TRUE
L R12,SCBADDR ERR 8
MVC WLB(8),LB
LA R0,12 *************************
LA R1,WLB VALIDATE SCB/LB MATCH
LA R2,SCBLB *************************
CLC WLB(8),SCBLB
BNE AUDITBUG SCB PREV/NEXT NE LB PREV/NEXT
BAL R14,CHKADDR
MVC LBNEXT,AFREELB CHAIN FREE QUEUE TO LB
ST R12,AFREELB POINT TO DELETED LB
L R12,WLBPREV
LTR R12,R12
BZ KRSHF6F GO UPDATE FIRST LB POINTER
BAL R14,CHKADDR
MVC LBNEXT,WLBNEXT SET NEXT IN PREV. LB
LTR R5,R5
BZ KRSHF6N GO UDATE PREV POINTER
LR R1,R7
SH R1,=AL2(LSCB)
MVC SCBNEXT-SCB(4,R1),WLBNEXT
B KRSHF6N
KRSHF6F EQU *
MVC GLBFIRST,WLBNEXT UPDATE FIRST LB POINTER
KRSHF6N EQU *
L R12,WLBNEXT
LTR R12,R12
BZ KRSHF6L IF LAST GO UPDATE LAST LB POINTER
BAL R14,CHKADDR
MVC LBPREV,WLBPREV SET PREV IN NEXT LB
CL R5,MAXROW
BNL KRSHF6E
LA R1,LSCB(R7)
MVC SCBPREV-SCB(4,R1),WLBPREV
B KRSHF6E
KRSHF6L EQU *
MVC GLBLAST,WLBPREV UPDATE LAST LB POINTER
KRSHF6E EQU *
CLC GLBCUR,SCBADDR IS CURRENT LINE BEING DELETED
BNE KRSHF6EX NO, EXIT
MVC GLBCUR,WLBNEXT YES, TRY NEXT
CLC GLBCUR,=A(0) IS NEXT NULL
BNE KRSHF6EX NO, EXIT
SP PCUR,=P'1'
MVC GLBCUR,WLBPREV YES, TRY PREV.
CLC GLBCUR,=A(0) IS FILE NOW EMPTY
BNE KRSHF6ND NO, GO DISPLAY PREV. LINE
BAL R14,NEWFILE YES, CREATE NULL FILE
KRSHF6ND EQU *
BAL R14,DISPLAY
B KRSHF6SC
KRSHF6EX EQU *
ST R5,SAVEROW
ST R7,SAVESCB
LR R3,R5
L R4,MAXROW
BAL R14,SCRLUP SCROLL SCREEN UP OVERLAYING DEL LINE
LA R6,0 RESET COLUMN
ZAP PCOL,=P'1'
CLC LASTSCB,MAXSCB WAS LAST ROW ACTIVE
BL KRSHF6NL NO, GO REDUCE LAST ROW POINTER
L R7,MAXSCB
L R12,SCBNEXT
LTR R12,R12 IS THERE NEW LINE FOR LAST ROW
BZ KRSHF6NL NO, GO DECREMENT LAST ROW
MVC SCBLB(LLB),LB MOVE IN NEW LAST LINE
ST R12,SCBADDR
MVI SCBMOD,FALSE
SR R3,R3
L R5,MAXROW
BAL R14,PUTLINE DISPLAY NEW LAST LINE
B KRSHF6XT
KRSHF6NL EQU * UPDATE NEW LAST ROW
L R5,LASTROW
L R7,LASTSCB
SH R5,=AL2(ROWINC)
SH R7,=AL2(LSCB)
ST R5,LASTROW
ST R7,LASTSCB
KRSHF6XT EQU *
L R5,SAVEROW
L R7,SAVESCB
CL R5,LASTROW
BNH KRSHF6SC
SP PCURLINE,=P'1'
L R5,LASTROW
L R7,LASTSCB
KRSHF6SC EQU *
BAL R14,AUDITMS
BAL R14,PUTPCT
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRF3 EQU * F3 (START OF LINE)
ST R14,KRSV14
LA R6,0
ZAP PCOL,=P'1'
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRF4 EQU * F4 (END OF LINE)
ST R14,KRSV14
IC R6,SCBCOL
CH R6,=AL2(79)
BNH KRF4SKPL
BCTR R6,0
KRF4SKPL EQU *
CVD R6,PWORK
ZAP PCOL,PWORK
AP PCOL,=P'1'
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRF5 EQU * F5 (LABEL BLOCK)
ST R14,KRSV14
CLI BLKLABEL,FALSE
BE KRF5MARK IF FALSE, SET MARK
CLI BLKLABEL,MARK IF MARK, SET TRUE
BE KRF5TRUE
MVI BLKLABEL,FALSE ELSE, TURN BLOCK LABEL BACK OFF
MVC STATBLK,=C' '
LA R3,STATBLK
LA R4,L'STATBLK
BAL R14,PUTSTAT
BAL R14,DISPLAY REMOVE MARKED LINES FROM SCREEN
KRF5EXIT EQU *
L R14,KRSV14
BR R14
KRF5MARK EQU *
LA R1,=CL20'MARKING BLOCK'
BAL R14,PUTMSG
MVI BOX,FALSE TURN OFF BOX GRAPHICS
MVI BLKLABEL,MARK
MVC STATBLK,=C'BLK'
LA R3,STATBLK
LA R4,L'STATBLK
BAL R14,PUTSTAT
BAL R14,CHKMARK
MVC BLK1LB,SCBADDR
ZAP PCURBLK1,PCURLINE
B KRF5EXIT
KRF5TRUE EQU *
LA R1,=CL20'POSITIONING BLOCK'
BAL R14,PUTMSG
MVI BLKLABEL,TRUE
MVC BLK2LB,SCBADDR
B KRF5EXIT
KRF6 EQU * F6 (DUPLICATE BLOCK)
ST R14,KRSV14
CLI BLKLABEL,TRUE
BNE KRF6NOTD NO DUP IF NO BLOCK DEFINED CURRENTLY
MVC PREVDUP,SCBPREV
L R12,BLK1LB
KRF6L1 EQU * CHECK IF CHAINED LB IN BLOCK
CL R12,BLK2LB
BE KRF6OK OK, GO DUPLICATE
CL R12,PREVDUP
BE KRF6NOTD NO DUP IF INSIDE BLOCK
MVC WLBNEXT,LBNEXT GET NEXT LB TO DUP.
L R12,WLBNEXT
LTR R12,R12
BNZ KRF6L1
KRF6NOTD EQU * NO DUP DUE TO NO BLK OR INSIDE BLK
LA R1,=CL20'NO DUP - INV. REQ.'
BAL R14,PUTMSG
L R14,KRSV14
BR R14
KRF6OK EQU * OK TO DUPLICATE
LA R1,=CL20'DUPLICATING BLOCK'
BAL R14,PUTMSG
MVC STATBLK,=C' '
LA R3,STATBLK
LA R4,L'STATBLK
BAL R14,PUTSTAT
MVI BLKLABEL,FALSE TURN OFF BLOCK
MVI FILEMOD,TRUE SET FILE CHANGE
BAL R14,UPDATE UPDATE MS FROM SCREEN BEFORE COPY
MVC SAVENEXT,SCBADDR SAVE NEXT TO STORE IN LAST
MVC NEXTBLK,BLK1LB
KRF6DUP EQU *
BAL R14,GETNEWLB
LTR R15,R15
BNZ KRF6LAST IF NO MORE LB'S, GO FINISH LAST LB
AP PLSTLINE,=P'1'
LTR R5,R5
BNZ KRF6SKPC IF INSERTING BEFORE FIRST LINE,
AP PCUR,=P'1' INCR CURRENT LINE COUNTERS
AP PCURLINE,=P'1'
KRF6SKPC EQU *
L R12,NEXTBLK
MVC WLB(LLB),LB GET FIRST LB TO DUP
MVC WLBPREV,PREVDUP
L R12,ANEWLB
BAL R14,CHKADDR
MVC LB(LLB),WLB COPY TO NEW LB
L R12,WLBPREV
LTR R12,R12
BNZ KRF6DUPP
MVC GLBFIRST,ANEWLB RESET FIRST LB
B KRF6DUPN
KRF6DUPP EQU * CHAIN PREVIOUS
BAL R14,CHKADDR
MVC LBNEXT,ANEWLB SET NEXT IN PREV LB
KRF6DUPN EQU *
MVC PREVDUP,ANEWLB
L R12,NEXTBLK
CL R12,BLK2LB IS THIS LAST BLOCK
BE KRF6LAST YES, GO SET NEXT POINTER
MVC NEXTBLK,LBNEXT NEXT BLOCK TO DUP
B KRF6DUP
KRF6LAST EQU *
L R12,PREVDUP
BAL R14,CHKADDR
MVC LBNEXT,SAVENEXT SET NEXT IN LAST LB
L R12,SAVENEXT
BAL R14,CHKADDR
MVC LBPREV,PREVDUP SET PREV IN NEXT LB
BAL R14,AUDITMS
BAL R14,PUTPCT
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KRF7 EQU * F7 (SEARCH)
ST R14,KRSV14
LA R1,=CL20'KEY='
BAL R14,PUTMSG
LA R1,4 SET STARTING COL IN STATMSG
BAL R14,GETWORD GET SEARCH KEY
CLI LWORD,L'WORD
BNL KRF7ABT2 EXIT NOW IF LENGTH ZERO OR ABORTED
MVC LKEYWORD,LWORD
MVC KEYWORD,WORD
XC FINDKEY,FINDKEY CLEAR TRT TABLE
MVI FINDKEY+ASCLF,ASCLF SET END OF RECORD TRAP
SR R1,R1
IC R1,KEYWORD
STC R1,FINDKEY(R1) SET TRAP FOR FIRST CHAR.
LA R6,20
BAL R14,SETCUR
LA R1,=CL20'REPLACE Y/N/G (CR=N)'
BAL R14,PUTMSG
BAL R14,GETKEY
MVC WLBNEXT,SCBADDR
MVC PCURSRCH,PCURLINE
SP PCURSRCH,=P'1'
MVI REPLACE,FALSE ASSUME NO REPLACE
MVI GLOBAL,FALSE ASSUME NO GLOBAL REPLACE
OI KEY,X'20'
CLI KEY,X'79' IS THIS A Y
BE KRF7REP YES, GO GET REPLACE WORD
CLI KEY,X'67' IS THIS A G (GLOBAL SERACH AND REPLACE)
BNE KRF7STRT NO, GO SEARCH ONLY
MVI GLOBAL,TRUE YES, SET GLOBAL REPLACE
KRF7REP EQU *
LA R1,=CL20'REP='
BAL R14,PUTMSG
LA R1,4
BAL R14,GETWORD GET REPLACE WORD IN WORD
CLI LWORD,X'AB'
BE KRF7ABT2 EXIT IF GETWORD ABORT
MVC LREPWORD,LWORD
MVC REPWORD,WORD SAVE IN REPWORD
MVI REPLACE,TRUE SET REPLACE MODE
KRF7STRT EQU *
BAL R14,UPDATE UPDATE FROM SCREEN BEFORE SEARCH
LA R1,=CL20'SEARCHING'
CLI REPLACE,TRUE
BNE KRF7SRCH
LA R1,=CL20'REPLACING'
KRF7SRCH EQU *
BAL R14,PUTMSG
LA R7,100
KRF7NXTL EQU * START SEARCH OF NEXT LINE
L R12,WLBNEXT
LTR R12,R12
BZ KRF7NOTF EXIT IF NOT FOUND
AP PCURSRCH,=P'1'
MVC WLB(LLB),LB MOVE NEXT LB TO WLB
SR R3,R3
LA R1,WLBLINE
BCT R7,KRF7NXTC
LA R0,X'0100'
SVC KEYBOARD
STCM R0,4,PWORK STORE LOW FLAGS
TM PWORK,X'40' IS THERE A KEY WAITING
BZ KRF7ABT1 YES, ABORT NOT FOUND
LA R7,100
MVC STATREC,=X'402020202020' UPDATE LINE BEING SEARCHED
ED STATREC,PCURSRCH
ZAP PCURLINE,PCURSRCH
LA R3,STATREC
LA R4,L'STATREC
BAL R14,PUTSTAT
SR R3,R3
LA R1,WLBLINE
KRF7NXTC EQU * SEARCH TO NEXT MATCHING FIRST CHAR.
TRT 0(L'WLBLINE,R1),FINDKEY FIRST CHAR. FOUND
CLM R2,1,=AL1(ASCLF) IS THIS END OF RECORD
BE KRF7NXTL YES, NEXT LINE
IC R3,LKEYWORD
EX R3,CLCKEYW DOES ENTIRE KEYWORD MATCH
BE KRF7HIT YES, EXIT WITH MATCHING LINE AT TOP
LA R1,1(R1) NO, SKIP MATCHING CHARACTER
B KRF7NXTC REPEAT SEARCH TO END OF LINE
KRF7HIT EQU * KEY FOUND
ST R12,GLBCUR MOVE LINE TO TOP OF SCREEN
MVC PCUR,PCURSRCH
CLI REPLACE,TRUE
BNE KRF7EXIT
MVI FILEMOD,TRUE RELEASE 1.4 FIX ****************
LA R4,1(R1,R3) R4=A(TEXT BEYOND KEY IN WLBLINE)
MVC SAVETEXT,0(R4)
LA R2,WLBLINE+L'WLBLINE-2
SR R2,R1 R2 = L'REMAINING TEXT IN WLBLINE-2
LR R4,R1 ASSUME NO REP
CLI LREPWORD,X'FF' IS THERE ANY REP
BE KRF7MTXT NO, GO OVERLAY KEY WTTH TEXT
IC R3,LREPWORD
SR R2,R3 R2 = L'TEXT BEYOND REP IN WLBLINE-1
BM KRF7HITE DON'T REPLACE IF IT WON'T FIT
EX R3,MVCREP MOVE REP OVER KEY
LA R4,1(R1,R3) R4 = A(TEXT BEYOND REP)
KRF7MTXT EQU *
EX R2,MVCTXT MOVE REMAINING TEXT BEHIND REP
BAL R14,CHKADDR
MVC LB(LLB),WLB UPDATE LB WITH REPLACEMENT
KRF7HITE EQU *
CLI GLOBAL,TRUE
BNE KRF7EXIT
LA R1,1(R1)
B KRF7NXTC
KRF7ABT1 EQU *
LA R0,X'0000' FLUSH INTERRUPT KEY
SVC KEYBOARD
KRF7ABT2 EQU *
LA R1,=CL20'ABORT SEARCH'
BAL R14,PUTMSG
B KRF7EXIT
KRF7NOTF EQU *
LA R1,=CL20'NOT FOUND'
BAL R14,PUTMSG
KRF7EXIT EQU *
BAL R14,AUDITMS
BAL R14,DISPLAY
L R14,KRSV14
BR R14
CLCKEYW CLC 0(0,R1),KEYWORD COMPARE ENTIRE KEYWORD
MVCREP MVC 0(0,R1),REPWORD MOVE REP OVERLAYING KEY
MVCTXT MVC 0(0,R4),SAVETEXT MOVE REMAINING TEXT BEHIND REP
TITLE 'GETWORD - READ STRING FROM KEYBOARD WORD'
*
* R1 = STARTING COL IN STATMSG
* LWORD = LENGTH - 1 OR X'FF' IF NONE OR X'AB' IF ABORTED
*
GETWORD EQU *
ST R14,GETWSV14
ST R5,SAVEROW
ST R6,SAVECOL
LR R6,R1
BAL R14,SETCUR UPDATE LINE AND COL BEFORE CHANGING
L R5,STATROW
LA R3,WORD
LA R4,L'WORD
GETWLOOP EQU *
STM R3,R4,GETWSV34
BAL R14,SETCUR
LA R0,X'0920' AH=9, AL= ASCII BLANK
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.
IC R1,ATTRIB BL=ATRIBUTE OF CHAR.
LA R14,1 CX=(COUNT OF CHAR TO WRITE)
SVC VIDEO DISPLAY BLANK AT CURSOR
BAL R14,GETKEY
LM R3,R4,GETWSV34
CLI KEY,ASCBS
BNE GETWCHKA
CL R3,=A(WORD)
BNH GETWLOOP IGNORE BS IF AT BEGINNING
BCTR R3,0
LA R4,1(R4)
BCTR R6,0
B GETWLOOP
GETWCHKA EQU *
CLI KEY,ASCCR
BE GETWOK
CLI KEY,X'20'
BL GETWQUIT
CLI KEY,X'80'
BNL GETWQUIT
LA R1,STATMSG(R6)
MVC 0(1,R1),KEY
LA R0,X'0900' AH=9
LA R1,X'0000' BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE)
IC R1,ATTRIB BL=ATRIBUTE OF CHAR.
LA R14,1 CX=(COUNT CHAR)
IC R0,KEY AL=CHAR
SVC VIDEO DISPLAY CHAR
LA R6,1(R6)
MVC 0(1,R3),KEY
LA R3,1(R3)
BCT R4,GETWLOOP
GETWQUIT EQU *
MVI LWORD,X'AB'
B GETWEXIT
GETWOK EQU *
LA R3,L'WORD-1
SR R3,R4
STC R3,LWORD SAVE LENGTH (X'FF' = NO CHAR)
GETWEXIT EQU *
L R5,SAVEROW
L R6,SAVECOL
BAL R14,SETCUR
L R14,GETWSV14
BR R14
KRF8 EQU * REPEAT F7 SEARCH
ST R14,KRSV14
MVC WLBNEXT,SCBNEXT
ZAP PCURSRCH,PCURLINE
B KRF7STRT
KRF9 EQU * SELECT COLOR
ST R14,KRSV14
SR R1,R1
IC R1,ATTRIB
LR R2,R1
N R1,=X'000000F0' R1 = LEFT NIBBLE * 16
N R2,=X'0000000F' R2 = RIGHT NIBBLE
ST R5,SAVEROW
ST R6,SAVECOL
LA R6,15
KRF9LOOP EQU *
LA R0,0(R1,R2)
STC R0,ATTRIB UPDATE ATTRIB
STM R1,R2,KRF9SV12 SAVE R1-R2 ACROSS I/O
MVC STATMSG,=CL20'COLOR BRGBIRGB'
BAL R14,DHEXATT
LA R3,STATMSG
LA R4,L'STATMSG
BAL R14,PUTSTAT
L R5,STATROW
LA R15,0(R5,R6)
LA R0,X'0200' AH=2 SET CURSOR
LA R1,0 BH=0 PAGE
SVC VIDEO
L R5,SAVEROW
BAL R14,GETKEY GET NEXT KEY (CR,ARROWS,0-9,A-F)
LM R1,R2,KRF9SV12
CLI KEY,ASCCR CR TO EXIT F9 WITH CURRENT ATTRIB
BE KRF9EXIT
CLI KEY,ASCUP UP ARROW TO INCR CURRENT NIBBLE
BNE KRF9CKDN
KRF9UP EQU *
CLM R6,1,=AL1(15)
BNE KRF9UP2
LA R1,16(R1)
N R1,=X'000000F0'
B KRF9LOOP
KRF9UP2 EQU *
LA R2,1(R2)
N R2,=X'0000000F'
B KRF9LOOP
KRF9CKDN EQU *
CLI KEY,ASCDOWN DOWN ARROW TO DEC CURRENT NIBBLE
BNE KRF9CHLF
CLM R6,1,=AL1(15)
BNE KRF9DN2
SH R1,=H'16'
N R1,=X'000000F0'
B KRF9LOOP
KRF9DN2 EQU *
BCTR R2,0
N R2,=X'0000000F'
B KRF9LOOP
KRF9CHLF EQU *
CLI KEY,ASCLEFT LEFT ARROW TO SELECT LEFT NIBBLE
BNE KRF9CHRG
LA R6,15
B KRF9LOOP
KRF9CHRG EQU *
CLI KEY,ASCRGHT RIGHT ARROW TO SELECT RIGHT NIBBLE
BNE KRF9HEX
LA R6,16
B KRF9LOOP
KRF9HEX EQU *
CLI KEY,X'80'
BNL KRF9LOOP
TR KEY,HEXTAB CONVERT ASCII KEY TO 0-F OR FF
CLI KEY,X'FF'
BE KRF9LOOP IGNORE INVALID CHAR.
SR R0,R0
IC R0,KEY
CLM R6,1,=AL1(15)
BNE KRF9HEX2
SLL R0,4
LR R1,R0 SET LEFT NIBBLE
LA R6,16 SWITCH NIBBLE
B KRF9LOOP
KRF9HEX2 EQU *
LR R2,R0 SET RIGHT NIBBLE
LA R6,15 SWITCH NIBBLE
B KRF9LOOP
KRF9EXIT EQU *
LA R0,X'0B00' AH=11 FOR SET COLOR PALETTE (TECH. A-49)
SR R1,R1
IC R1,ATTRIB
SRL R1,4
N R1,=X'00000007' SET BACKGROUND T SAME AS ATTRIB
SVC VIDEO
BAL R14,NEWSTAT REFRESH STATUS LINE WITH NEW ATTRIBUTE
L R5,SAVEROW
L R6,SAVECOL
BAL R14,SETCUR
L R14,KRSV14
BR R14
DHEXATT EQU * DISPLAY ATTRIBUTE IN HEX
SR R1,R1
IC R1,ATTRIB
SRL R1,4
IC R1,HEX(R1)
STC R1,STATMSG+15
IC R1,ATTRIB
N R1,=X'0000000F'
IC R1,HEX(R1)
STC R1,STATMSG+16
BR R14
KRF10 EQU * BOX GRAPHICS
ST R14,KR10SV14
CLI BOX,TRUE IF BOX MODE ON, TURN IT OFF
BE KRF10OFF ELSE TURN IT ON
MVI BOX,TRUE
MVI BLKLABEL,FALSE TURN OFF BLOCK MODE
MVC STATBLK,=C'BOX' DISPLAY BOX MODE USING BLK IND.
LA R3,STATBLK
LA R4,L'STATBLK
BAL R14,PUTSTAT
CLI KBINS,INSSTATE IF INSERT MODE ON, TURN IT OFF
BNE KRF10EXT
BAL R14,KRINS
B KRF10EXT
KRF10OFF EQU *
MVI BOX,FALSE
MVC STATBLK,=C' '
LA R3,STATBLK
LA R4,L'STATBLK
BAL R14,PUTSTAT
KRF10EXT EQU *
L R14,KR10SV14
BR R14
KRSHF1 EQU * SHIFT F1 (QUICK SAVE)
ST R14,KRSV14
BAL R14,SAVEFILE SAVE FILE NOW AND RESET FILEMOD
L R14,KRSV14
BR R14
KRSHF10 EQU * SWITCH BOX GRAPHIC CHARACTER SET
ST R14,KRSV14
L R1,BOXSETA ADDRESS OF BOX GRAPHIC CHARACTERS
CLI CONNECT,TRUE
BE KRSHF10A GO TOGGLE SET1/SET2 IN CONNECT MODE
LA R1,8(R1) INCR TO NEXT SET
CL R1,=A(BOXSETE) IS THIS END OF TABLE
BL KRSHF10S
LA R1,BOXSET YES, RESET TO FIRST SET
B KRSHF10S
KRSHF10A EQU *
CL R1,=A(BOXSET1) IF SET1, SWITCH TO SET 2
BE KRSHF102
KRSHF101 EQU *
LA R1,BOXSET1
B KRSHF10S
KRSHF102 EQU *
LA R1,BOXSET2
KRSHF10S EQU *
ST R1,BOXSETA UPDATE BOX SET POINTER
KRPRTSET EQU *
LA R1,=CL20'BOX CHAR = '
BAL R14,PUTMSG
L R1,BOXSETA
MVC STATMSG+11(8),0(R1)
MVI STATMSG+19,X'00'
SR R1,R1
IC R1,ATTRIB
LA R2,STATMSG+11
L R15,STATROW
LA R15,11(R15)
SVC PRINTTXT PRINT GRAPHIC BOX CHARACTERS
L R14,KRSV14
BR R14
KRALTF10 EQU * TOGGLE CONNECT MODE
ST R14,KRSV14
CLI CONNECT,TRUE
BE KRAF10R
MVI CONNECT,TRUE SET CONNECT ON WITH SINGLE LINE
MVC BOXSETA,=A(BOXSET1)
LA R1,=CL20'CONNECT MODE SET'
BAL R14,PUTMSG
L R14,KRSV14
BR R14
KRAF10R EQU *
MVI CONNECT,FALSE
LA R1,=CL20'CONNECT MODE OFF'
BAL R14,PUTMSG
L R14,KRSV14
BR R14
KRALTF1 EQU * ALT-F1 PAUSE UNTIL KEY HIT
ST R14,KRWTSV14
CLI KSMODE,KSREAD
BE KRAF1GET
LA R1,=CL20'PAUSE'
BAL R14,PUTMSG
B KRALTEXT
KRAF1GET EQU *
LA R1,=CL20'PAUSE - PRESS ENTER'
BAL R14,PUTMSG
LA R0,X'0000'
SVC KEYBOARD READ NEXT KEY AND IGNORE
KRALTEXT EQU *
L R14,KRWTSV14
BR R14
KRALTF2 EQU * ALT-F2 WAIT A SECOND
ST R14,KRWTSV14
LA R1,=CL20'WAIT A SECOND'
BAL R14,PUTMSG
CLI KSMODE,KSREAD
BNE KRALTEXT
L R1,=A(3000) SET WAIT LOOP COUNT
KRALTF2L EQU *
BCT R1,KRALTF2L
L R14,KRWTSV14
BR R14
KRALTF3 EQU * ENTER DEBUG MODE
ST R14,KRSV14
SVC TRACE
DC C'BUG '
BAL R14,NEWSTAT CLEAN UP SCREEN AFTER DEBUG
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KRALTF4 EQU * TOGGLE AUDIT MODE
ST R14,KRSV14
XI AUDIT,TRUE
CLI AUDIT,TRUE
LA R1,=CL20'AUDIT MODE ON'
BE KRAF4MSG
LA R1,=CL20'AUDIT MODE OFF'
KRAF4MSG EQU *
BAL R14,PUTMSG
L R14,KRSV14
BR R14
KRALTF5 EQU * GOTO LINE #
ST R14,KRSV14
LA R1,=CL20'LINE='
BAL R14,PUTMSG
LA R1,5
BAL R14,GETWORD
CLI LWORD,L'WORD
BNL KRA5ERR IF LENGTH 0, IGNORE
SR R1,R1
IC R1,LWORD
EX R1,TRTWORD
BNZ KRA5ERR IF NOT ASCII NUMERIC, IGNORE
EX R1,PCKWORD
OI PWORD+L'PWORD-1,X'0F' CONVERT ASCII DIGIT SIGN
CP PWORD,PLSTLINE IF PAST END, IGNORE
BH KRA5ERR
CP PWORD,=P'1'
BL KRA5ERR IF NOT GE 1, IGNORE
CP PWORD,PCUR
BL KRA5LOW LINE IS BELOW CURRENT LINE
ZAP PWORK,PLSTLINE
SP PWORK,PWORD PWORK IS DISTANCE FROM END
ZAP PWORK1,PWORD
SP PWORK1,PCUR PWORK1 IS DISTANCE FROM CUR
CP PWORK,PWORK1 IS IT SHORTER VIA PCUR OR PLSTLINE
BH KRA5FWD GO FORWARD FROM CURRENT POS.
ZAP PCUR,PLSTLINE
MVC GLBCUR,GLBLAST
B KRA5BAK GO BACKWORD FROM END
TRTWORD TRT WORD(0),NUMERIC TEST WORD FOR NUMERIC LINE #
PCKWORD PACK PWORD,WORD(0) PACK WORD
KRA5LOW EQU *
ZAP PWORK,PCUR
SP PWORK,PWORD PWORK IS DISTANCE FROM CUR
CP PWORK,PWORD IS IT SHORTER FROM START OR CUR
BL KRA5BAK GO BACKWARD FROM CUR
ZAP PCUR,=P'1'
MVC GLBCUR,GLBFIRST
KRA5FWD EQU * GO FORWARD FROM PCUR TO PWORD
CP PCUR,PWORD
BE KRA5EXIT
L R12,GLBCUR
MVC WLBNEXT,LBNEXT
CLC WLBNEXT,=A(0)
BE KRA5ERR ERROR IF EOF FOUND
AP PCUR,=P'1'
MVC GLBCUR,WLBNEXT
B KRA5FWD
KRA5BAK EQU * GO BACKWARD FROM PCUR TO PWORD
CP PCUR,PWORD
BE KRA5EXIT
L R12,GLBCUR
MVC WLBPREV,LBPREV
CLC WLBPREV,=A(0)
BE KRA5ERR ERROR IF EOF FOUND
SP PCUR,=P'1'
MVC GLBCUR,WLBPREV
B KRA5BAK
KRA5ERR EQU *
LA R1,=CL20'INVALID LINE #'
BAL R14,PUTMSG
KRA5EXIT EQU *
BAL R14,DISPLAY
L R14,KRSV14
BR R14
KRBS EQU * BACK SPACE
ST R14,KRSV14
LTR R6,R6
BZ KRDELCHR
BCTR R6,0
SP PCOL,=P'1'
BAL R14,SETCUR
L R14,KRSV14
B KRDELCHR
KRHT EQU * HORIZONTAL TAB
ST R14,KRSV14
CH R6,=H'9'
BL KRHTC10
CH R6,=H'15'
BL KRHTC16
N R6,=X'000000FC' FORCE TO MULTIPLE OF 4
CVD R6,PWORK
ZAP PCOL,PWORK
AP PCOL,=P'1'
LA R6,4(R6) ADD 4
AP PCOL,=P'4'
CH R6,=H'79'
BNH KRHTEXIT
KRHTC0 EQU *
SR R6,R6
ZAP PCOL,=P'1'
B KRHTEXIT
KRHTC10 EQU *
LA R6,10-1
ZAP PCOL,=P'10'
B KRHTEXIT
KRHTC16 EQU *
LA R6,16-1
ZAP PCOL,=P'16'
KRHTEXIT EQU *
BAL R14,SETCUR
L R14,KRSV14
BR R14
KRHTAUTO EQU * TOGGLE AUTO TAB MODE
XI HTMODE,TRUE
BR R14
KRCTLK EQU * ROUTE TO CTL-K B,C,D,K,Q,Y
ST R14,KRSV14
BAL R14,GETKEY
L R14,KRSV14
OI KEY,X'40' MAKE CTL A-Z = A-Z
CLI KEY,X'42'
BE KRF5 CTL-K B F5 MARK BLOCK BEGIN
CLI KEY,X'43'
BE KRF6 CTL-K C F6 DUPLICATE BLOCK
CLI KEY,X'44'
BE KRESC CTL-K D ESCAPE
CLI KEY,X'4B'
BE KRF5 CTL-K K F5 MARK BLOCK END
CLI KEY,X'51'
BE KRBREAK CTL-K Q CONTROL BREAK
CLI KEY,X'59'
BE KRCTLKY CTL-K Y DELETE BLOCK
BR R14
KRCTLQ EQU * ROUTE TO CTL-Q A,C,D,F,I,R,S
ST R14,KRSV14
BAL R14,GETKEY
L R14,KRSV14
OI KEY,X'40' MAKE CTL A-Z = A-Z
CLI KEY,X'41'
BE KRF7 CTL-Q A F7 SEARCH/REPLACE
CLI KEY,X'43'
BE KREND CTL-Q C END
CLI KEY,X'44'
BE KRF4 CTL-Q D END OF LINE
CLI KEY,X'46'
BE KRF7 CTL-Q F F7 SEARCH/REPLACE
CLI KEY,X'49'
BE KRHTAUTO CTL-Q I AUTO TAB
CLI KEY,X'52'
BE KRHOME CTL-Q R HOME
CLI KEY,X'53'
BE KRF3 CTL-Q S START OF LINE
BR R14
KRBREAK EQU * CTL-K Q BREAK
SVC EXIT
TITLE 'CHKMARK - IF IN MARK MODE, PRINT IN REVERSE VIDEO'
CHKMARK EQU *
CLI BLKLABEL,MARK
BNER R14
ST R14,CHKMSV14
CLI KEY,ASCUP IS CURRENT KEY UP
BNE CHKMARK1
MVI BLKLABEL,FALSE TURN OFF MARKING ON UP ARROW
CHKMARK1 EQU *
SR R3,R3
BAL R14,PUTLINE
MVI BLKLABEL,MARK RESET MARKING
L R14,CHKMSV14
BR R14
TITLE 'UPDATE - UPDATE SCREEN LINES IN EXTENDED STORAGE'
UPDATE EQU *
ST R14,UPDTSV14
CLI SCRMOD,TRUE HAS SCREEN BEEN MODIFIED
BNER R14 NO, EXIT NOW
MVI FILEMOD,TRUE SET FILE MODIFY SWITCH
MVI SCRMOD,FALSE RESET SCREEN MODIFY SWITCH
LR R2,R7 SAVE R7
L R7,ASCB
USING SCB,R7
UPDTLOOP EQU *
CLI SCBMOD,TRUE
BNE UPDTNEXT
L R12,SCBADDR
BAL R14,CHKADDR
USING LB,R12
MVC LBLINE(L'SCBLINE),SCBLINE
UPDTNEXT EQU *
LA R7,LSCB(R7)
CL R7,LASTSCB
BNH UPDTLOOP
LR R7,R2 RESTORE R7
BAL R14,AUDITMS
L R14,UPDTSV14
BR R14
TITLE 'CHKADDR - VALIDATE SCB ADDRESS BEFORE WRITE'
CHKADDR EQU *
CL R12,MINMEM
BL E05
CL R12,MAXMEM
BNL E05
BR R14
TITLE 'GETNEWLB - ALLOCATE NEW LB SPACE IN EXT. MEMORY IF AVAIL.'
GETNEWLB EQU *
L R1,GFQEL IS THERE ROOM FOR LB LEFT IN PRIMARY AREA
SH R1,=AL2(LLB)
BM CHKFREE NO, GO CHECK FREE QUEUE
ST R1,GFQEL UDATE LENGTH OF PRIMARY AREA
L R1,GFQEA
ST R1,ANEWLB SET ADDRESS OF ALLOCATED LB
LA R1,LLB(R1)
ST R1,GFQEA UPDATE ADDRESS
B GETMEXIT
CHKFREE EQU *
L R1,AFREELB IS THERE AN LB ON FREE QUEUE
LTR R1,R1
BZ GETMERR NO, EXIT WITH ERROR
ST R1,ANEWLB SET ADDRESS OF ALLOCATED LB
LR R12,R1
MVC AFREELB,LBNEXT UPDATE NEXT FREE LB
GETMEXIT EQU *
SR R15,R15
BR R14
GETMERR EQU *
ST R14,GETMSV14
LA R1,=CL20'** OUT OF MEMORY **'
BAL R14,PUTMSG
LA R15,4
L R14,GETMSV14
BR R14
TITLE 'ERROR MESSAGES'
E01 EQU *
LA R2,=C'E01 - I/O ERROR ON INPUT FILE$'
ERR EQU *
SVC WTO
SVC TRACE
DC C'ERR '
SVC TRACE
DC C'BUG '
SVC EXIT
E02 EQU *
LA R2,=C'E02 - MS-DOS EXTENDED MEMORY ALLOCATION ERROR$'
B ERR
E03 EQU *
LA R2,=C'E03 - NO MEMORY AVAILABLE FOR ADDITIONAL RECORD$'
LA R15,3
BR R14
E04 EQU *
EOFUT2 EQU *
LA R2,=C'E04 - EOF ON KEYBOARD SIMULATOR FILE$'
B ERR
E05 EQU *
LA R2,=C'E05 - INVALID EXTENDED MEMORY ADDRESS$'
B ERR
TITLE 'DATA SECTION'
LTORG
*
* REGISTER USAGE
*
R0 EQU 0 WORK
R1 EQU 1 WORK
R2 EQU 2 WORK
R3 EQU 3 WORK
R4 EQU 4 WORK
R5 EQU 5 ROW IN 3RD BYTE
R6 EQU 6 COL IN 4TH BYTE
R7 EQU 7 BASE FOR SCREEN CONTROL BLOCK SCB
R8 EQU 8 FIRST BASE
R9 EQU 9 SECOND BASE
R10 EQU 10 THIRD BASE
R11 EQU 11 LENGTH FOR CROSS MEMORY MOVE
R12 EQU 12 BASE FOR LB IN EXTENDED STORAGE
R13 EQU 13 SAVE AREA
R14 EQU 14 LINK FROM MAINLINE TO ROUTINES
R15 EQU 15 RETURN CODE FROM ROUTINES
*
* PC/370 SVC'S
*
EXIT EQU 0
OPEN EQU 1
CLOSE EQU 2
GET EQU 5
PUT EQU 6
DELETE EQU 7
SEARCH EQU 8
TRACE EQU 9
GETMAIN EQU 10
FREEMAIN EQU 11
ASCEBC EQU 12
EBCASC EQU 13
RENAME EQU 23
PRINTTXT EQU 24 MICRO-CODE PRINTING OF TEXT ON ROW VIA PC/370
VIDEO EQU 128+16 BIOS VIDEO-IO (TECH. REF. A-48)
KEYBOARD EQU 128+22 BIOS KEYBOARD (TECH. REF. A-26)
WRITECHR EQU 200+2 MS-DOS SVC 2 DISPLAY CHAR IN R2 ON CONSOLE
READKEY EQU 200+7 MS-DOS SVC 7 GET KEY WITHOUT ECHO
WTO EQU 200+9 MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
*
* DATA AREAS
*
ASCBS EQU X'08' ASCII BACKSPACE
ASCLF EQU X'0A' ASCII LINE FEED
ASCCR EQU X'0D' ASCII CARRIAGE RETURN
ASCASK EQU X'2A' ASCII ASTERISK FOR ALC COMMENT CHECK
ASCBLK EQU X'20' ASCII SPACE
ASCTAB EQU X'09' ASCII TAB
ASCRIGHT EQU X'1C' ASCII CURSOR RIGHT
ASCF1 EQU X'BB' EXTENDED ASCII F1 WITH HIGH BIT ON
ASCF2 EQU X'BC' EXTENDED ASCII F2 WITH HIGH BIT ON
ASCALTF1 EQU X'E8' EXTENDED ASCII ALT-F1 WITH HIGH BIT ON
ASCALTF2 EQU X'E9' EXTENDED ASCII ALT-F2 WITH HIGH BIT ON
ASCUP EQU X'C8' EXTENDED ASCII UP ARROW WITH HIGH BIT ON
ASCDOWN EQU X'D0' EXTENDED ASCII DOWN ARROW WITH HIGH BIT
ASCLEFT EQU X'CB' EXTENDED ASCII LEFT ARROW
ASCRGHT EQU X'CD' EXTENDED ASCII RIGHT ARROW
ESCAPE EQU X'1B' ASCII ESCAPE KEY
DC C'**** KEY ****'
KEY DC X'00' KEY FROM KEYBOARD OR EMULATOR FILE
DC C'*** LAST KEY ***'
LASTKEY DC X'00' PREV KEY FROM KEYBOARD
DC C'**** WAITLOOP *****'
WAITLOOP DC F'1' DEFAULT WAIT LOOP IS 1
PWORD DC PL8'0'
WORD DC CL15' ' WORD READ VIA GET WORD
LWORD DC X'00' LENGTH OF WORD READ-1 OR X'FF' IF ZERO
KEYWORD DC CL15' ' SEARCH KEY WORD
LKEYWORD DC X'00' SAVE LENGTH OF KEYWORD - 1 FOR F8
REPWORD DC CL15' ' REPLACE WORD
LREPWORD DC X'00' SAVE LENGTH OF REPLACE - 1 FOR F8
SAVETEXT DC CL80' ' SAVE TEXT FOLLOWING KEY FOR REPLACE
FINDKEY DC XL256'00' TRT TABLE FOR FIRST CHAR. IN KEYWORD
FINDTAB DC 256X'00' TRT TABLE TO FIND TABS OR EOR
ORG FINDTAB+ASCLF
DC AL1(ASCLF)
ORG FINDTAB+ASCTAB
DC AL1(ASCTAB)
ORG FINDTAB+256
NUMERIC DC 48X'FF',10X'00',198X'FF' TRT ASCII NUMERIC TEST
HEX DC C'0123456789ABCDEF' CONVERT NIBBLE TO EBCDIC
HEXTAB DC 128X'FF' CONVERT ASCII TO NIBBLE
ORG HEXTAB+X'30'
DC AL1(0,1,2,3,4,5,6,7,8,9) ASCII 0-9
ORG HEXTAB+X'41'
DC AL1(10,11,12,13,14,15) ASCII A-F
ORG HEXTAB+X'61'
DC AL1(10,11,12,13,14,15) ASCII A-F
ORG HEXTAB+128
*
* KEY ROUTINE ADDRESS TABLE
*
KRTAB DS 0F
DC A(0) ZERO FUNCTION CODE NOT USED
KEYUND DC A(KRUND) KEY UNDEFINED
KEYCHAR DC A(KRCHAR) PROCESS CHARACTER UPDATE ON SCREEN
KEYESC DC A(KRESC) ESCAPE KEY
KEYPGDN DC A(KRPGDN) PAGE DOWN
KEYPGUP DC A(KRPGUP) PAGE UP
KEYUP DC A(KRUP) CURSOR UP
KEYLEFT DC A(KRLEFT) CURSOR LEFT
KEYRIGHT DC A(KRRIGHT) CURSOR RIGHT
KEYDOWN DC A(KRDOWN) CURSOR DOWN
KEYINS DC A(KRINS) INSERT
KEYDEL DC A(KRDEL) DELETE
KEYCR DC A(KRCR) CARRIAGE RETURN
KEYBS DC A(KRBS) BACK SPACE
KEYHT DC A(KRHT) HORIZONTAL TAB
KEYHOME DC A(KRHOME) HOME (TOP OF FILE)
KEYEND DC A(KREND) END (END OF FILE)
KEYALTF1 DC A(KRALTF1) ENTER PAUSE UNTIL KEY HIT FOR EMULATOR
KEYALTF2 DC A(KRALTF2) ENTER WAIT FOR 1 SECOND FOR EMULATOR
KEYALTF3 DC A(KRALTF3) ENTER DEBUG MODE
KEYALTF4 DC A(KRALTF4) TOGGLE AUDIT MODE
KEYALTF5 DC A(KRALTF5) GO TO LINE #
KEYALTFA DC A(KRALTF10) TOGGLE CONNECT BOX GRAPHIC MODE
KEYF1 DC A(KRF1) F1 HELP SCREEN 1
KEYF2 DC A(KRF2) F2 HELP SCREEN 2
KEYF3 DC A(KRF3) F3 START OF LINE
KEYF4 DC A(KRF4) F4 END OF LINE
KEYF5 DC A(KRF5) F5 LABEL BLOCK
KEYF6 DC A(KRF6) F6 DUPLICATE BLOCK
KEYF7 DC A(KRF7) F7 SEARCH
KEYF8 DC A(KRF8) F8 REPEAT LAST F7 SEARCH
KEYF9 DC A(KRF9) F9 SELECT COLOR
KEYF10 DC A(KRF10) F10 BOX GRAPHICS
KEYSHF1 DC A(KRSHF1) SHIFT F1 QUICK SAVE
KEYSHF3 EQU KEYF3 SHFT-F3 START OF LINE
KEYSHF4 EQU KEYF4 SHFT-F4 END OF LINE
KEYSHF6 DC A(KRSHF6) SHIFT F6 DELETE LINE
KEYSHF7 DC A(KRHTAUTO) SHIFT F7 AUTO TAB
KEYSHF9 DC A(KRHTAUTO) SHIFT F9 AUTO TAB
KEYSHF10 DC A(KRSHF10) SHIFT F10 (CHANGE BOX GRAPHIC CHAR SET)
KEYCTLC EQU KEYPGDN CTL-C PAGE DOWN
KEYCTLD EQU KEYRIGHT CTL-D CURSOR RIGHT
KEYCTLE EQU KEYUP CTL-E CURSOR UP
KEYCTLG EQU KEYDEL CTL-G DELETE
KEYCTLH EQU KEYBS CTL-H BACKSPACE
KEYCTLI EQU KEYHT CTL-I TAB
KEYCTLK DC A(KRCTLK) CTL-K ROUTE TO B,C,D,K,Q,Y
KEYCTLL EQU KEYF8 CTL-L REPEAT SEARCH
KEYCTLN EQU KEYCR CTL-N CARRIAGE RETURN OR ENTER
KEYCTLQ DC A(KRCTLQ) CTL-Q ROUTE TO A,C,D,F,I,R,S
KEYCTLR EQU KEYPGUP CTL-R PAGE UP
KEYCTLS EQU KEYLEFT CTL-S CURSOR LEFT
KEYCTLU EQU KEYINS CTL-U INSERT
KEYCTLX EQU KEYDOWN CTL-X CURSOR DOWN
KEYCTLY EQU KEYSHF6 CTL-Y DELETE LINE
*
* KEY ROUTINE TRANSLATE TABLE WITH INDEX TO KRTAB
*
KEYTAB DC 32AL1(KEYUND-KRTAB) DEFAULT UNDEFINED 0-31
DC 96AL1(KEYCHAR-KRTAB) DEFAULT CHAR 32-127
DC 128AL1(KEYUND-KRTAB) DEFAULT UNDEFINED 128-255
*
* OVERLAY DEFAULT INDEX VALUES WITH SPECIFIC KEY ROUTINE INDEXES
* (SEE MASIC MANUAL APPENDIX G-7 FOR OFFSETS)
*
ORG KEYTAB+X'03'
DC AL1(KEYCTLC-KRTAB) CTL-C PAGE DOWN
DC AL1(KEYCTLD-KRTAB) CTL-D CURSOR RIGHT
DC AL1(KEYCTLE-KRTAB) CTL-E CURSOR UP
ORG KEYTAB+X'07'
DC AL1(KEYCTLG-KRTAB) CTL-G DELETE
DC AL1(KEYBS-KRTAB) CTL-H BACK SPACE
DC AL1(KEYHT-KRTAB) CTL-I HORIZONTAL TAB
ORG KEYTAB+X'0B'
DC AL1(KEYCTLK-KRTAB) CTL-K ROUTE B,C,D,K,Q,Y
DC AL1(KEYCTLL-KRTAB) CTL-L REPEAT LAST SEARCH
DC AL1(KEYCR-KRTAB) CARRIAGE RETURN (ENTER)
DC AL1(KEYCTLN-KRTAB) CTL-N INSERT LINE
ORG KEYTAB+X'11'
DC AL1(KEYCTLQ-KRTAB) CTL-Q ROUTE A,C,D,F,I,R,S
DC AL1(KEYCTLR-KRTAB) CTL-R PAGE UP
DC AL1(KEYCTLS-KRTAB) CTL-S CURSOR LEFT
ORG KEYTAB+X'15'
DC AL1(KEYCTLU-KRTAB) CTL-U INSERT
ORG KEYTAB+X'18'
DC AL1(KEYCTLX-KRTAB) CTL-X DOWN
DC AL1(KEYCTLY-KRTAB) CTL-Y DELETE LINE
ORG KEYTAB+X'1B'
DC AL1(KEYESC-KRTAB) ESCAPE KEY
ORG KEYTAB+128+59
DC AL1(KEYF1-KRTAB) F1 HELP SCREEN 1
DC AL1(KEYF2-KRTAB) F2 HELP SCREEN 2
DC AL1(KEYF3-KRTAB) F3 START OF LINE
DC AL1(KEYF4-KRTAB) F4 END OF LINE
DC AL1(KEYF5-KRTAB) F5 LABEL BLOCK OF LINES
DC AL1(KEYF6-KRTAB) F6 DUPLICATE BLOCK OF LINES
DC AL1(KEYF7-KRTAB) F7 SEARCH
DC AL1(KEYF8-KRTAB) F8 REPEAT SEARCH
DC AL1(KEYF9-KRTAB) F9 COLOR SELECTION
DC AL1(KEYF10-KRTAB) F10 DISPLAY FREE MEMORY
ORG KEYTAB+128+71
DC AL1(KEYHOME-KRTAB) HOME
ORG KEYTAB+128+72
DC AL1(KEYUP-KRTAB) CURSOR UP
ORG KEYTAB+128+73
DC AL1(KEYPGUP-KRTAB) PAGE UP
ORG KEYTAB+128+75
DC AL1(KEYLEFT-KRTAB) CURSOR LEFT
ORG KEYTAB+128+77
DC AL1(KEYRIGHT-KRTAB) CURSOR RIGHT
ORG KEYTAB+128+79
DC AL1(KEYEND-KRTAB) END
ORG KEYTAB+128+80
DC AL1(KEYDOWN-KRTAB) CURSOR DOWN
ORG KEYTAB+128+81
DC AL1(KEYPGDN-KRTAB) PAGE DOWN
ORG KEYTAB+128+82
DC AL1(KEYINS-KRTAB) INSERT
ORG KEYTAB+128+83
DC AL1(KEYDEL-KRTAB) DELETE
ORG KEYTAB+128+84
DC AL1(KEYSHF1-KRTAB) SHFT-F1 QUICK SAVE
ORG KEYTAB+128+86
DC AL1(KEYSHF3-KRTAB) SHFT-F3 START OF LINE
ORG KEYTAB+128+87
DC AL1(KEYSHF4-KRTAB) SHFT-F4 END OF LINE
ORG KEYTAB+128+89
DC AL1(KEYSHF6-KRTAB) SHFT-F6 DELETE LINE
ORG KEYTAB+128+90
DC AL1(KEYSHF7-KRTAB) SHFT-F7 SET AUTO TAB (INDENT)
ORG KEYTAB+128+92
DC AL1(KEYSHF9-KRTAB) SHFT-F9 SET AUTO TAB (INDENT)
ORG KEYTAB+128+93
DC AL1(KEYSHF10-KRTAB) SHFT-F10 CHANGE BOX GRAPHIC SET
ORG KEYTAB+128+104
DC AL1(KEYALTF1-KRTAB) ALT-F1 PAUSE UNTIL KEY HIT
ORG KEYTAB+128+105
DC AL1(KEYALTF2-KRTAB) ALT-F2 WAIT ONE SECOND
ORG KEYTAB+128+106
DC AL1(KEYALTF3-KRTAB) ALT-F3 ENTER DEBUG MODE
ORG KEYTAB+128+107
DC AL1(KEYALTF4-KRTAB) ALT-F4 TOGGLE AUDIT MODE
ORG KEYTAB+128+108
DC AL1(KEYALTF5-KRTAB) ALT-F5 GO TO LINE #
ORG KEYTAB+128+113
DC AL1(KEYALTFA-KRTAB) ALT-F10 TOGGLE BOX CONNECT MODE
*
* END OF KEYTAB
*
ORG KEYTAB+256
ATTRIB DC X'17' WHITE ON BLUE DEFAULT SCREEN
ATTSAVE DC X'00' SAVE DURING REVERSE VIDEO MARKING
* SEE TECH. HANDBOOK 1-140 FOR COLOR ATTIRBUTES ON IBM COLOR MONITOR
* USE X'0E' FOR TURBO PASCAL DEFAULT YELLOW ON BLACK
SAVEAREA DC 9D'0'
INITSV14 DC A(0) SAVE LINK FOR INIT
HELPSV14 DC A(0) SAVE LINK FOR HELPSCRN
TERMSV14 DC A(0) SAVE LINK FOR TERMKS
LOADSV14 DC A(0) SAVE LINK FOR LOADFILE
EDITSV14 DC A(0) SAVE LINK FOR EDITFILE
SAVESV14 DC A(0) SAVE LINK FOR SAVEFILE
DISPSV14 DC A(0) SAVE LINK FOR DISPLAY
SETCSV14 DC A(0) SAVE LINK FOR SETCUR
CLRSV14 DC A(0) SAVE LINK FOR CLEAR
CLRLSV14 DC A(0) SAVE LINK FOR CLRLINE
GETKSV14 DC A(0) SAVE LINK FOR GETKEY
PUTLSV14 DC A(0) SAVE LINK FOR PUTLINE
PUTSSV14 DC A(0) SAVE LINK FOR PUTSTAT
CHKMSV14 DC A(0) SAVE LINK FOR CHKMARK
NEWFSV14 DC A(0) SAVE LINK FOR NEWFILE
UPDTSV14 DC A(0) SAVE LINK FOR UPDATE
SCRLSV14 DC A(0) SAVE LINK FOR SCRLDOWN, SCRLUP
KRCRSV14 DC A(0) SAVE LINK FOR KRCR
INSCSV14 DC A(0) SAVE LINK FOR KRINSCOM
KEYSSV14 DC A(0) SAVE LINK FOR KEYSTATS
PPCTSV14 DC A(0) SAVE LINK FOR PUTPCT
KR10SV14 DC A(0) SAVE LINK FOR KRF10
KRBXSV14 DC A(0) SAVE LINK FOR KRCHKBOX
SCHRSV14 DC A(0) SAVE LINK FOR KRSETCHR
GETWSV14 DC A(0) SAVE LINK FOR GETWORD
GETMSV14 DC A(0) SAVE LINK FOR GETNEWLB
KRWTSV14 DC A(0) SAVE LINK FOR KRALTF1/F2
KRSV14 DC A(0) COMMON SAVE FOR FIRST LEVEL KR ROUTINES
SAVER0R3 DS 4F SAVE AREA FOR AUDIT ROUTINES (REQ'D FOR SEARCH)
KRF9SV12 DS 2F SAVE AREA FOR F9
GETWSV34 DS 2F SAVE AREA FOR GETWORD ACROSS GETKEY
TRUE EQU 1
FALSE EQU 0
MARK EQU 2 MARKING BLK LABEL MODE
DC C'*** AUDIT ***'
ALC DC AL1(TRUE) FILE TYPE ALC (USED FOR TAB PROCESSING)
AUDIT DC AL1(FALSE) AUDIT SWITCH FOR AUDITSCB AND AUDITMS
HTMODE DC AL1(FALSE) AUTO TAB MODE
EOF1 DC AL1(FALSE) END OF FILE
EOJ DC AL1(FALSE) END OF JOB
FILEMOD DC AL1(FALSE) FILE MODIFIED
SCRMOD DC AL1(FALSE) SCREEN MODIFIED
BLKLABEL DC AL1(FALSE) LABELED BLOCK (TRI-STATE FALSE,MARK,TRUE)
SAVBLKLB DC AL1(FALSE) SAVE LABELD BLK MODE DURING DISPLAY
CURDEL DC AL1(FALSE) CURRENT LB DELETED
FIRSTSAV DC AL1(TRUE) FIRST SAVE REQUEST
REPLACE DC AL1(FALSE) SEARCH AND REPLACE
GLOBAL DC AL1(FALSE) GLOBAL REPLACE
BOX DC AL1(FALSE) BOX CHARACTER GRPAHICS MODE
CONNECT DC AL1(FALSE) BOX GRAPHIC CONNECT MODE
DIRUP EQU 0
DIRRIGHT EQU 1
DIRDOWN EQU 2
DIRLEFT EQU 3
DIRLAST DC AL1(DIRRIGHT)
DIRNEW DC AL1(DIRRIGHT)
DIRTAB DC AL1(BU,BUR,BD,BUL,BRU,BR,BUL,BL)
DC AL1(BU,BLU,BD,BRU,BLU,BR,BUR,BL)
BU EQU 0 UP
BD EQU 1 DOWN
BUR EQU 2 UPPER LEFT
BUL EQU 3 UPPER RIGHT
BRU EQU 4 LOWER RIGHT
BR EQU 5 RIGHT
BL EQU 6 LEFT
BLU EQU 7 LOWER LEFT
REVDIR DC AL1(DIRDOWN,DIRLEFT,DIRUP,DIRRIGHT) REVERSE OF DIRECTION
REVLAST DC AL1(0) SAVE REV OF DIRLAST
BOXSET EQU *
BOXSET2 DC AL1(186,186,201,187,188,205,205,200) GRAPHIC DOUBLE LINE BOX
BOXSET1 DC AL1(179,179,218,191,217,196,196,192) GRAPHIC SINGLE LINE BOX
DC 8AL1(ASCASK) ASCII * PRINTABLE BOX
DC AL1(94,118,88,88,88,62,60,88) ARROWS (SORT OF)
DC 8AL1(ASCBLK) BLANK (FOR BG COLORS)
BOXSETE EQU *
BOXSETA DC A(BOXSET) ADDRESS OF CURRENT BOX SET
BOXCON EQU * TABLE TO CONNECT SINGLE/DOUBLE BOX LINES
*
* SEE IBM TECH. REF. FOR PC PAGES C-7 THRU C-9 FOR GRAPHICS 179-218
*
* ---- SINGLE --- ---- DOUBLE ---
* UP RT DN LF UP RT DN LF
*
DC AL1(179,195,179,180,186,198,186,181) 179
DC AL1(180,197,180,180,180,180,180,181) 180
DC AL1(181,181,181,180,181,216,181,181) 181
DC AL1(182,215,182,182,182,182,182,185) 182
DC AL1(183,210,191,183,182,183,183,187) 183
DC AL1(181,184,184,191,184,209,187,184) 184
DC AL1(185,185,185,182,185,206,185,185) 185
DC AL1(179,199,179,182,186,204,186,185) 186
DC AL1(187,187,184,183,185,203,187,187) 187
DC AL1(190,188,188,189,188,202,185,188) 188
DC AL1(217,208,189,189,189,189,182,188) 189
DC AL1(190,190,181,217,188,207,190,190) 190
DC AL1(180,194,191,191,191,191,183,184) 191
DC AL1(192,192,195,193,211,212,192,192) 192
DC AL1(193,193,197,193,208,193,193,193) 193
DC AL1(197,194,194,194,194,194,210,194) 194
DC AL1(195,195,195,197,195,198,195,195) 195
DC AL1(193,196,194,196,208,205,210,205) 196
DC AL1(197,197,197,197,197,197,197,197) 197
DC AL1(198,195,198,198,198,198,198,216) 198
DC AL1(199,199,199,215,199,204,199,199) 199
DC AL1(212,211,200,200,200,200,204,202) 200
DC AL1(201,214,213,201,204,201,201,203) 201
DC AL1(207,202,202,202,202,202,206,202) 202
DC AL1(203,203,209,203,206,203,203,203) 203
DC AL1(204,199,204,204,204,204,204,206) 204
DC AL1(207,196,209,196,202,205,203,205) 205
DC AL1(206,206,206,206,206,206,206,206) 206
DC AL1(207,207,216,207,202,207,207,207) 207
DC AL1(193,208,208,208,208,208,215,208) 208
DC AL1(216,209,209,209,209,209,203,209) 209
DC AL1(210,210,194,210,215,210,210,210) 210
DC AL1(192,211,211,208,211,200,209,211) 211
DC AL1(212,192,198,212,200,212,212,207) 212
DC AL1(198,218,213,213,213,213,201,209) 213
DC AL1(214,214,218,210,209,201,214,214) 214
DC AL1(215,215,215,215,215,215,215,215) 215
DC AL1(216,216,216,216,216,216,216,216) 216
DC AL1(217,193,180,217,189,217,217,190) 217
DC AL1(195,218,218,194,218,213,214,218) 218
SCRLEND EQU 23*256+79 SCROLL ENDING ROW AND COL
SAVETYPE DC CL3' ' SAVE ORIG. FILE TYPE
ROWINC EQU 256 INCREMENT FOR ROW IN R5 REG. (3RD BYTE)
MAXROW DC A(23*ROWINC) LAST ROW ON SCREEN
MAXSCB DC A(0) LAST ROW SCB POINTER
LASTROW DC A(0) LAST ROW CURSOR
LASTSCB DC A(0) LAST SCB ADDR
SAVEROW DC A(0) TEMP SAVE FOR ROW (R5)
SAVECOL DC A(0) TEMP SAVE FOR COL (R6)
SAVESCB DC A(0) TEMP SAVE FOR SCB (R7)
BLK1LB DC A(0) STARTING LB OF BLOCK
BLK2LB DC A(0) ENDING LB OF BLOCK
NEXTBLK DC A(0) NEXT LB TO DUPLICATE
SAVENEXT DC A(0) SAVE NEXT LB FROM CURRENT LB
PREVDUP DC A(0) PREVIOUS LB IN DUPLICATE CHAIN
PTOTAL DC PL3'0'
LOADMSG DC C' LINES LOADED ='
DTOTAL DC CL6' ZZZZZ',C'$'
LBUFF1 EQU 8192
LBUFF2 EQU 4096
LBUFFS EQU LBUFF1+LBUFF2
TBUFF EQU X'80' COMMAND LINE IN LOW MEMORY
ATYPE1 DC A(DSN1+4) DEFAULT ADDR OF .XXX IN DSN
DSN1 DC C'TEST.ALC',64X'00' DSN FROM COMMAND
REN1 DC C'TEST.BKP',64X'00' RENAME DSN FOR SAVE
SYSUT1 DS 0D DCB FOR ASCII TEXT FILE READ/WRITE
DC C'ADCB'
DC A(DSN1) ADDRESS OF UP TO 64 BYTE PATH/FILE
DC X'FFFF' HANDLE ASSIGNED BY MS-DOS AT OPEN
DC X'00' DATA CONTROL BLOCK FLAGS
DC C'S' DATA SET ORGANIZATION
DC C'G' DATA SET ACCESS MODE
DC C'T' DATA SET RECORD FORMAT
DC X'0A' END OF RECORD CODE
DC X'1A' END OF FILE CODE
DC H'135' RECORD LENGTH
DC AL2(LBUFF1) BLOCK LENGTH (2<BLKSZ<64K-16)
DC A(EOFUT1) END OF DATA EXIT ADDRESS
DC A(E01) SYCHRONOUS ERROR EXIT ADDRESS
DC A(WLBLINE) RECORD AREA ADDRESS FOR GET/PUT
DC A(0) BLOCK AREA ADDRESS (0 FOR DYNAM)
DC A(0) RELATIVE BYTE ADDRESS
DC A(REN1) RENAME ASCIIZ FILE
DC F'0' BLOCK I/O COUNT SINCE OPEN
DC H'0' PHYSICAL BLOCK SIZE OF LAST READ/WRITE
*
* RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
*
DC XL4'00' SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
DC XL4'00' SEGMENT:OFFSET OF EODAD EXIT
DC XL4'00' SEGMENT:OFFSET OF SYNAD EXIT
DC XL4'00' SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
DC XL4'00' SEGMENT:OFFSET OF RENAME FILE NAME
DC XL4'00' SEGMENT:OFFSET OF BLOCK AREA
DC XL4'00' SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
DC XL2'00' OFFSET OF CURRENT END OF DATA IN BLOCK AREA
DC XL2'00' OFFSET OF END OF ALLOCATED BLOCK AREA
DC H'0' REVERSED LRECL
DC H'0' REVERSED BLKSZ
*
* DATA FOR KEYBOARD SIMULATOR
*
KSOFF EQU 0
KSREAD EQU 1
KSWRITE EQU 2
DC C'**** KSREC ****'
KSREC DC XL256'00'
KSRECEND EQU *
DC C'**** KSNEXT ****'
KSNEXT DC A(KSRECEND) ASSUME READ AND SET TO FORCE NEXT READ
KSMODE DC AL1(KSOFF)
DSN2 DC C'TEST.KSF',64X'00' DSN FROM COMMAND LINE
SYSUT2 DS 0D DCB FOR KEYBOARD SIMULATOR
DC C'ADCB'
DC A(DSN2) ADDRESS OF UP TO 64 BYTE PATH/FILE
DC X'FFFF' HANDLE ASSIGNED BY MS-DOS AT OPEN
DC X'00' DATA CONTROL BLOCK FLAGS
DC C'S' DATA SET ORGANIZATION
DC C'G' DATA SET ACCESS MODE
DC C'F' DATA SET RECORD FORMAT
DC X'0A' END OF RECORD CODE
DC X'1A' END OF FILE CODE
DC H'256' RECORD LENGTH
DC AL2(LBUFF2) BLOCK LENGTH (2<BLKSZ<64K-16)
DC A(EOFUT2) END OF DATA EXIT ADDRESS
DC A(E01) SYCHRONOUS ERROR EXIT ADDRESS
DC A(KSREC) RECORD AREA ADDRESS FOR GET/PUT
DC A(0) BLOCK AREA ADDRESS (0 FOR DYNAM)
DC A(0) RELATIVE BYTE ADDRESS
DC A(0) RENAME ASCIIZ FILE
DC F'0' BLOCK I/O COUNT SINCE OPEN
DC H'0' PHYSICAL BLOCK SIZE OF LAST READ/WRITE
*
* RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
*
DC XL4'00' SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
DC XL4'00' SEGMENT:OFFSET OF EODAD EXIT
DC XL4'00' SEGMENT:OFFSET OF SYNAD EXIT
DC XL4'00' SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
DC XL4'00' SEGMENT:OFFSET OF RENAME FILE NAME
DC XL4'00' SEGMENT:OFFSET OF BLOCK AREA
DC XL4'00' SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
DC XL2'00' OFFSET OF CURRENT END OF DATA IN BLOCK AREA
DC XL2'00' OFFSET OF END OF ALLOCATED BLOCK AREA
DC H'0' REVERSED LRECL
DC H'0' REVERSED BLKSZ
*
* DATA FOR LINE BLOCKS
*
DC C'*** FIRST/LAST/CUR ***'
GLBFIRST DC A(0) GLOBAL POINTER TO FIRST LB
GLBLAST DC A(0) GLOBAL POINTER TO LAST LB
GLBCUR DC A(0) GLOBAL POINTER TO CURRENT LB
DC C'*** GFQEA/L ***'
GFQEA DC A(0) ADDRESS OF REMAINING FREE EXTENDED MEMORY
GFQEL DC F'0' LENGTH OF REMAINING FREE EXTENDED MEMORY
MINMEM DC A(0) LOW LIMIT
MAXMEM DC A(0) MAX LIMIT
ANEWLB DC A(0) LB ALLOCATED BY GETNEWLB
AFREELB DC A(0) QUEUE OF FREE LB'S CREATED BY DELETE
WLBADDR DS A
WLB DS 0X
WLBPREV DC A(0)
WLBNEXT DC A(0)
WLBLINE DC CL80' ',CL80' ' PAD FOR EXPANDING TABS AND PRINT FILES
DC AL1(ASCCR,ASCLF)
TLBADDR DS A
TLB DS 0X
TLBPREV DS A
TLBNEXT DS A
TLBLINE DS CL80,CL53
STATRC0 EQU 24*256
STATROW DC A(STATRC0)
STATLINE DS 0CL80
STATMSG DC CL20'LOADING FILE ',C' '
STATNAME DC CL15' ',C' LINE'
STATREC DC CL6' ',C' COL'
STATCOL DC CL4' ',C' '
STATCAP DC CL3' ',C' ' CAPS KEY ON/OFF
STATINS DC CL3' ',C' ' INSERT MODE ON/OFF
STATNUM DC CL3' ',C' ' NUM KEY ON/OFF
STATBLK DC CL3' ',C' ' LABELED BLOCK ON/OFF (F5, CTL-K B/K)
STATPCT DC CL4' ',C'%'
DC (STATLINE+80-*)C' '
DC X'00' EOR FOR PRINTTXT
KBCAP DC X'00' CAPS KEY STATUS VIA BIOS KEYBOARD
KBINS DC X'00' INS KEY STATUS VIA BIOS KEYBOARD (SEE NOTES)
KBNUM DC X'00' NUM KEY STATUS VIA BIOS KEYBOARD
KBCAPLST DC X'00'
KBINSLST DC X'00'
KBNUMLST DC X'00'
INSSTATE EQU X'80' INSERT KEY ON (TECH. A-3)
CAPSTATE EQU X'40' CAPS KEY ON
NUMSTATE EQU X'20' NUM KEY ON
PBLKCNT DC PL3'0' RECORDS IN BLOCK
PCURBLK1 DC PL3'0' RECORD # OF FIRST BLOCK RECORD
PCUR DC PL3'1' CURRENT RECORD # FOR ROW 0
PCURLINE DC PL3'1' CURRENT RECORD # FOR CURSOR ROW
PCURSRCH DC PL3'0' CURRENT RECORD # FOR SEARCH
PLSTLINE DC PL3'0' LAST RECORD #
PCHKLINE DC PL3'0' AUDIT LAST RECORD #
PCOL DC PL2'0' CURRENT COL
PCURLAST DC PL3'0' LAST REC UPDATE BY SETCUR
PCOLLAST DC PL2'0' LAST COL UPDATE BY SETCUR
FMAXLINE DC F'0' MAXIMUM LINES POSSIBLE IN MS
PWORK DC D'0' PACKED DECIMAL WORK AREA
PWORK1 DC D'0'
DC C'*** ASCB ***'
ASCB DC A(0) ADDRESS OF SCREEN CONTROL BLOCK
F1SC EQU *
DC CL80'SEE Screen Editor and Emulator R2.2 01/03/88'
DC CL80' '
DC CL80'Copyright (c) 1987 Donald S. Higgins'
DC CL80' '
DC CL80'Type F1 for this screen; F2 for keystroke help.'
DC CL80'For additional documentation, SEE PC370.DOC.'
DC CL80' '
DC CL80'SEE is a full screen color text editor distributed'
DC CL80'in source and object form with the PC/370 freeware'
DC CL80'370 cross assembler, linkage editor, and emulator'
DC CL80'package. You are encouraged to copy and share'
DC CL80'this program provided this copyright message is'
DC CL80'not removed or modified and no fee is charged.'
DC CL80'If you find PC/370 of value, support continued'
DC CL80'freeware updates by registering as PC/370 user.'
DC CL80' '
DC CL80' Don Higgins'
DC CL80' 6365 - 32 Avenue North'
DC CL80' St. Petersburg, Florida 33710'
F1SCEND EQU *
F2SC EQU *
* 0 1 2 3 4
* 1 0 0 0 0
DC CL40'KEY ALTERNATE DESCRIPTION ' 1
DC CL40'KEY ALTERNATE DESCRIPTION '
DC CL80' ' 2
DC CL40'Esc ctl-K D save file and exit ' 3
DC CL40'PgUp ctl-R page up half '
DC CL40'PgDn ctl-C page down half ' 4
DC CL40'arrows ctl-S/D/E/X move cursor '
DC CL40'home ctl-Q R go to top of file ' 5
DC CL40'End ctl-Q C go to end of file '
DC CL40'Ins ctl-U set/reset insert ' 6
DC CL40'Del ctl-G/K Y delete char/block '
DC CL40'Tab ctl-I tab to next column ' 7
DC CL40'Bs ctl-H backspace '
DC CL40'Enter ctl-N next/insert line ' 8
DC CL40'F1/F2 help screen 1/2 '
DC CL40'F3/F4 ctl-Q S/D start/end line ' 9
DC CL40'F5/F6 ctl-K B/K/C label/dup. block '
DC CL40'F7 ctl-Q F/A search/replace str. ' 10
DC CL40'F8 ctl-L repeat search/repl. '
DC CL40'F9 set color ' 11
DC CL40'F10 set/reset box graph '
DC CL40'Shft-F1 quick save file ' 12
DC CL40'Shft-F6 ctl-Y delete line '
DC CL40'Shft-F9 ctl-Q I set/reset auto tab ' 13
DC CL40'Shft-F10 change box graph set'
DC CL40'Ctl-brk ctl-K Q force exit no save ' 14
DC CL40'Alt-F1 pause until key hit '
DC CL40'Alt-F2 wait for 1 second ' 15
DC CL40'Alt-F3 enter debug mode '
DC CL40'Alt-F4 toggle audit mode ' 16
DC CL40'Alt-F5 go to line # '
DC CL40'Alt-F10 toggle box connect ' 17
DC CL40' '
DC CL80' '
DC CL80'Note F9 color selection is changed by entering'
DC CL80'hex digits or using arrows to select digit and'
DC CL80'change colors. Press enter to continue.'
DC CL80'Note F10, shift-F10, and alt-F10 control box'
DC CL80'graphic mode, characters, and connect options.'
F2SCEND EQU *
*
* DSECTS
*
*
* LINE BLOCK FOR STORING TEXT IN EXTENDED MEMORY
*
LB DSECT
LBPREV DS A ADDRESS OF PREVIOUS LB
LBNEXT DS A ADDRESS OF NEXT LB
LBLINE DS CL80 TEXT
LLB EQU *-LB
*
* SCREEN CONTROL BLOCK
*
SCB DSECT
SCBADDR DS A ADDRESS OF LB IN EXTENDED STORAGE
SCBLB DS 0XL(LLB) LB WITHIN SCB
SCBPREV DS A ADDRESS OF PREV LB
SCBNEXT DS A ADDRESS OF NEXT LB
SCBLINE DS CL80 LINE OF TEXT
DS XL2 PAD FOR CR,NL FOR FULL LINE OF TEXT
SCBCOL DS X COL CONTAINING CR/LF (END OF TEXT + 1)
SCBMOD DS X SET TRUE IF MODIFIED
LSCB EQU *-SCB
****************************************************************************
*
* IHADCB - I HAD A DCB DSECT FOR PC/370 RELEASE 2.0+ FILE DATA CONTROL BLOCK
*
* FOR MORE INFORMATION SEE SVC.DOC AND DEMO PROGRAM TESTIO.ALC.
*
****************************************************************************
IHADCB DSECT
DCBDCB DS CL4 CONSTANT EBCDIC C'ADCB' DCB IDENTIFIER
DCBDSN DS A ADDRESS OF UP TO 64 BYTE PATH/FILE SPEC FOLLOWED BY ZERO
DCBFID DS H FILE HANDLE ASSIGNED BY MS-DOS AT OPEN (X'FFFF'DEFAULT)
DCBFLG DS X DATA CONTROL BLOCK FLAGS (ONLY DFTRAN MAY BE SET BY USER)
DFOPEN EQU X'80' FILE OPEN
DFUBUF EQU X'40' USER DEFINED BLOCK AREA (NO DYNAMIC ALLOC/DEALLOC)
DFOUT EQU X'20' OPEN FOR OUTPUT
DFGEOF EQU X'10' END OF FILE PENDING ON SHORT BLOCK
DFTRAN EQU X'08' TRANSLATE GET/PUT RECORDS FOR ASCII FILE
DFADCB EQU X'01' ASSIST DCB - DO NOT TRANSLATE 370 ADDRESSES
DSORG DS C DATA SET ORGANIZATION (R=RANDOM, S=SEQUENTIAL)
MACRF DS C DATA SET ACCESS MODE (R=READ, W=WRITE, G=GET, P=PUT)
RECFM DS C DATA SET RECORD FORMAT (F=FIXED, V=VAR, T=TEXT)
EOR DS X END OF RECORD CODE (DEFAULT IS LINE FEED X'0A')
EOF DS X END OF FILE CODE (DEFAULT IS CTL-Z X'1A')
LRECL DS H RECORD LENGTH (2<LRECL<64K-16)
BLKSZ DS H BLOCK LENGTH (2<BLKSZ<64K-16)
EODAD DS A END OF DATA EXIT ADDRESS
SYNAD DS A SYCHRONOUS ERROR EXIT ADDRESS
RCD DS A RECORD AREA ADDRESS FOR GET/PUT
BLK DS A BLOCK AREA ADDRESS (0 FOR DYNAMICALLY ALLOCATED)
RBA DS A RELATIVE BYTE ADDRESS FOR RANDOM READ/WRITE
REN DS A RENAME ASCIIZ FILE (ONLY USED BY RENAME SVC)
IOCNT DS F BLOCK I/O COUNT SINCE OPEN
PRECL DS H PHYSICAL BLOCK SIZE OF LAST READ/WRITE
*
* RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
*
DSNSG DS XL4 SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
EODSG DS XL4 SEGMENT:OFFSET OF EODAD EXIT
SYNSG DS XL4 SEGMENT:OFFSET OF SYNAD EXIT
RCDSG DS XL4 SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
RENSG DS XL4 SEGMENT:OFFSET OF RENAME FILE NAME
BLKSG DS XL4 SEGMENT:OFFSET OF BLOCK AREA
BLKPTR DS XL4 SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
BLKEOD DS XL2 OFFSET OF CURRENT END OF DATA IN BLOCK AREA
BLKEND DS XL2 OFFSET OF END OF ALLOCATED BLOCK AREA
WLRECL DS H REVERSED LRECL
WBLKSZ DS H REVERSED BLKSZ
LDCB EQU *-IHADCB
END SEE

Reference in New Issue View Git Blame Copy Permalink