home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / ASMUTL / PC370.ZIP / SEE.ALC < prev    next >
Encoding:
Text File  |  1987-05-21  |  97.5 KB  |  3,194 lines
  1.     TITLE 'SEE.ALC - PC/370 SCREEN EDITOR AND EMULATOR'
  2. *
  3. * AUTHOR.    Don Higgins.
  4. *
  5. * DATE.      04/06/86.
  6. *
  7. * REMARKS.   PC/370 screen editor and emulator.
  8. *
  9. * COPYRIGHT. Copyright (c) 1987 Donald S. Higgins.
  10. *
  11. *            This source program and its derivative object and
  12. *            machine code programs may be freely copied and
  13. *            distributed provided this copyright message in the
  14. *            source program and in the object program help screen
  15. *            is not removed or modified, and that no fee is charged.
  16. *            The remainder of the program may be modified as you see
  17. *            fit to customize it to your specific needs.  If you send
  18. *            me useful enhancements, I will include them in the next
  19. *            release of PC/370 with appropriate credits.  If you find
  20. *            PC/370 of value, support continued freeware updates by
  21. *            sending 45 dollars to:
  22. *
  23. *            Don Higgins
  24. *            6365 - 32 Avenue North
  25. *            St. Petersburg, Florida 33710
  26. *
  27. * MAINTENANCE
  28. *
  29. *   07/19/86 DSH TESTING OF SEE R1.0 VERSION COMPLETED AND READY FOR SHIP WITH
  30. *                RELEASE R1.2 OF PC/370.
  31. *   09/11/86 DSH SEE RELEASE 1.1
  32. *                 1.  ADD BOX MODE LOGIC TO CONNECT SINGLE AND DOUBLE LINES AT
  33. *                     INTERSECTIONS.
  34. *                 2.  MODIFY F1 SCREEN FOR FPC HELP # FOR INTERNAL USE.
  35. *                 3.  SET FILE DEFAULT TO TEST.ALC INSTEAD OF BLANK NAME.
  36. *   09/16/86 DSH SEE RELEASE 1.2
  37. *                 1.  ADD ALT-F10 BOX CONNECT MODE TOGGLE KEY.
  38. *   09/19/86 DSH SEE RELEASE 1.3
  39. *                 1.  FIX SINGLE LINE CROSSING VERTICAL DOUBLE LT TO RT.
  40. *   04/28/87 DSH SEE RELEASE 1.4
  41. *                 1.  FIX SEARCH AND REPLACE TO SET FILEMOD IF MATCH.
  42. *                 2.  STARTUP IN INSERT MODE FOR NEW FILE.
  43. *                 3.  ALLOW 132 BYTE INPUT RECORDS TRUNCATED TO 80.
  44. *   04/29/87 DSH SEE RELEASE 2.0
  45. *                 1.  CONVERT TO PC/370 RELEASE 2.0 WITH NEW FILE PATHING
  46. *                     I/O SUPPORT WITH NEW DCB.
  47. *                 2.  USE GETMAIN/FREEMAIN IN VIRTUAL ADDRESS SPACE INSTEAD
  48. *                     OF CROSS MEMORY MVCP/MVCS.
  49. *   05/21/87 DSH - UPDATE SOURCE AND HELP SCREEN MESSAGES
  50. *
  51. *  INPUT
  52. *
  53. *  1.  A>SEE file1 file2
  54. *
  55. *      file1 - Name of new or existing ASCII text file to edit.
  56. *              Maximum size is about 512k with 640k memory.
  57. *              The default suffix is ALC.
  58. *
  59. *      file2 - Optional name of new or existing keyboard simulator file.
  60. *              The default suffix is KSF.  If the file is new all keystrokes
  61. *              entered during the current edit session will be recorded in
  62. *              the file.  If the file is old, the entire edit session will
  63. *              be simulated using the keystrokes in the file.  This feature
  64. *              is used to run validation tests on the editor.  It can also
  65. *              be used to create animated displays for demonstrations.
  66. *
  67. * OUTPUT
  68. *
  69. *  1.  Input file1 will be replaced with new file with changes.
  70. *  2.  Old file1 will be renamed with suffix of (.BAK).
  71. *  3.  Keyboard controls are designed to be compatible with
  72. *      both TURBO PASCAL and PFS:WRITE.  For definitions see
  73. *      F1 and F2 help screen text in data section of program.
  74. *      (you can search via (F7) for label F1SC and F2SC)
  75. *
  76. *
  77. SEE      CSECT
  78.     USING *,R15
  79.     STM   R14,R12,12(R13)
  80.     BAL   R15,START
  81.     DROP  R15
  82.     DC    18F'0'
  83. START    EQU   *
  84.     ST    R13,4(R15)
  85.     ST    R15,8(R13)
  86.     LR    R13,R15
  87.     USING SEE+8,R13
  88.     LA    R8,2048(R13)
  89.     LA    R8,2048(R8)
  90.     USING SEE+8+4096,R8
  91.     LA    R9,2048(R8)
  92.     LA    R9,2048(R9)
  93.     USING SEE+8+4096+4096,R9
  94.     LA    R10,2048(R9)
  95.     LA    R10,2048(R10)
  96.     USING SEE+8+4096+4096+4096,R10
  97.     BAL   R14,GETPARM     PROCESS PARM FILE NAMES
  98.     LTR   R15,R15
  99.     BNZ   SEEEND
  100.     BAL   R14,INIT        INITIALIZE SCREEN AND POINTERS
  101.     LTR   R15,R15
  102.     BNZ   SEEEND
  103.     BAL   R14,LOADFILE    LOAD FILE INTO EXTENDED STORAGE
  104.     CLI   EOJ,TRUE
  105.     BE    SEEEND
  106.     BAL   R14,EDITFILE    EDIT FILE IN FULL SCREEN MODE
  107.     BAL   R14,SAVEFILE    SAVE FILE IF MODIFIED
  108.     BAL   R14,TERMKSF     TERMINATE KSF IF ACTIVE
  109. SEEEND   EQU   *
  110.     LA    R0,X'0003'     AH=0,AL=2 FOR 25X80 COLOR MODE
  111.     SVC   VIDEO          SET MODE AND CLEAR SCREEN (TECH. A-48)
  112.     LA    R0,X'0200'     AH=2 SET CURSOR
  113.     LA    R1,0           BH=0 PAGE
  114.     LA    R15,X'0000'    DH=ROW,DL=COL
  115.     SVC   VIDEO          SET CURSOR TO UPPER LEFT CORNER
  116.     LA    R0,X'0920'     AH=10, AL=SPACE
  117.     LA    R1,X'0000'     BH=0 PAGE,BL=ATTRIB.
  118.     LA    R1,X'07'       CLEAR SCREEN WITH BLACK ON WHITE
  119.     LA    R14,25*80      CHARACTERS ON DATA LINES
  120.     SVC   VIDEO          CLEAR DATA LINES
  121.     LA    R0,X'0B00'
  122.     SR    R1,R1
  123.     SVC   VIDEO           RESET BACKGROUND TO MS-DOS BLACK
  124.     SVC   EXIT            EXIT TO MS-DOS
  125.     TITLE 'GETPARM - MOVE PARM TO DCB'
  126. GETPARM  EQU   *
  127.     SR    R2,R2
  128.     IC    R2,TBUFF
  129.     LR    R4,R2           SAVE ELGNTH
  130.     LA    R1,TBUFF+1
  131.     SVC   ASCEBC          TRANSLATE COMMAND TO EBCDIC
  132. GETDSN1  EQU   *
  133.     LA    R3,TBUFF+1      R3 = ADDRESS COMMAND PATH/FILENAME
  134.     CH    R4,=H'1'
  135.     BL    GETDSN2         USE DEFAULT IF NO FILENAME
  136.     LA    R5,DSN1         R5 = SYSUT1 PATH/FILENAME
  137.     SR    R6,R6           R6 = ADDR OF SUFFIX . IF ANY
  138. SKPLSP1  EQU   *               SKIP LEADING SPACES
  139.     CLI   0(R3),C' '
  140.     BNE   MVCDSN1
  141.     LA    R3,1(R3)
  142.     BCT   R4,SKPLSP1
  143.     B     KSDONE          USE DEFAULT IF ALL BLANKS
  144. MVCDSN1  EQU   *
  145.     CLI   0(R3),C' '      IF SPACE, CHK SUFFIX
  146.     BE    CHKALC
  147.     MVC   0(1,R5),0(R3)
  148.     CLI   0(R5),C'.'
  149.     BNE   SKPPD1
  150.     LR    R6,R5
  151.     ST    R6,ATYPE1      SAVE ADDRESS OF .XXX IN DSN1
  152. SKPPD1   EQU   *
  153.     LA    R5,1(R5)
  154. SKPBLK1  LA    R3,1(R3)
  155.     BCT   R4,MVCDSN1
  156. CHKALC   EQU   *
  157.     MVI   0(R5),X'00'    ADD ZERO BYTE
  158.     LTR   R6,R6
  159.     BZ    ADDALC
  160.     CLC   0(4,R6),=C'.ALC'
  161.     BE    GETDSN2
  162.     MVI   ALC,FALSE
  163.     B     GETDSN2
  164. ADDALC   EQU   *
  165.     ST    R5,ATYPE1      SAVE ADDRESS OF .ALC ADDED TO DSN1
  166.     MVC   0(4,R5),=C'.ALC'
  167.     MVI   4(R5),X'00'    ADD ZERO BYTE
  168. *
  169. *  PROCESS SECOND FILE PARM IF PRESENT AS KEYBOARD SIMULATOR FILE
  170. *
  171. GETDSN2  EQU   *
  172.     CH    R4,=H'1'
  173.     BL    KSDONE     IF NO SECOND FILE, EXIT NOW
  174.     LA    R5,DSN2         R5 = SYSUT2 PATH/FILENAME
  175.     SR    R6,R6           R6 = ADDR OF SUFFIX . IF ANY
  176. MVCDSN2  EQU   *
  177.     CLI   0(R3),C' '      IF SPACE, CHK SUFFIX
  178.     BE    SKPBLK2
  179.     MVC   0(1,R5),0(R3)
  180.     CLI   0(R5),C'.'
  181.     BNE   SKPPD2
  182.     LR    R6,R5
  183. SKPPD2   EQU   *
  184.     LA    R5,1(R5)
  185. SKPBLK2  LA    R3,1(R3)
  186.     BCT   R4,MVCDSN2
  187. CHKKSF   EQU   *
  188.     MVI   0(R5),X'00'    ADD ZERO BYTE
  189.     LTR   R6,R6
  190.     BNZ   SKPTYP2
  191. ADDKSF   EQU   *
  192.     MVC   0(4,R5),=C'.KSF'
  193.     MVI   4(R5),X'00'    ADD ZERO BYTE
  194. SKPTYP2  EQU   *
  195.     MVI   KSMODE,KSREAD   ASSUME READ MODE
  196.     LA    R2,SYSUT2
  197.     USING IHADCB,R2
  198.     SVC   SEARCH
  199.     CLM   R0,1,=X'00'
  200.     BE    KSOPEN
  201.     MVI   KSMODE,KSWRITE   IF NOT FOUND, SET WRITE MODE
  202.     MVC   KSNEXT,=A(KSREC) RESET POINTER FOR WRITE
  203.     MVI   MACRF,C'P'       RESET DCB TO PUT
  204.     DROP  R2
  205. KSOPEN   EQU   *
  206. *******  MVI   AUDIT,TRUE       SET DEFAULT AUDIT MODE FOR EMULATION
  207.     LA    R2,SYSUT2
  208.     SVC   OPEN
  209. KSDONE   EQU   *
  210.     CLI   KSMODE,KSREAD
  211.     BE    KSSKPOFF
  212.     SVC   TRACE
  213.     DC    C'IOF '          TURN KEYBOARD INTERRUPTS OFF
  214. KSSKPOFF EQU   *
  215.     SR    R15,R15
  216.     BR    R14
  217.     TITLE 'INIT - INITIALIZE SCREEN AND POINTERS'
  218. INIT     EQU   *
  219.     ST    R14,INITSV14
  220.     LA    R0,X'0003'     AH=0,AL=2 FOR 25X80 COLOR MODE
  221.     SVC   VIDEO          SET MODE AND CLEAR SCREEN (TECH. A-48)
  222.     LA    R0,X'0200'  AH=2 SET CURSOR
  223.     LA    R1,0        BH=0 PAGE
  224.     LA    R15,X'0000' DH=ROW,DL=COL
  225.     SVC   VIDEO       SET CURSOR TO UPPER LEFT CORNER
  226.     LA    R0,X'0920'  AH=10, AL=SPACE
  227.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  228.     IC    R1,ATTRIB
  229.     LA    R14,25*80   CHARACTERS ON DATA LINES
  230.     SVC   VIDEO       CLEAR DATA LINES
  231.     LA    R0,X'0B00'     AH=11 FOR SET COLOR PALETTE (TECH. A-49)
  232.     SR    R1,R1
  233.     IC    R1,ATTRIB
  234.     SRL   R1,4
  235.     N     R1,=X'00000007' TURN OFF BLINK BIT
  236.     SVC   VIDEO           SET BACKGROUND COLOR TO SAME AS ATTRIB
  237.     L     R1,=X'00FFFFFF'
  238.     SVC   GETMAIN
  239.     CLM   R0,1,=X'00'
  240.     BE    E02            VERIFY MAX. MEMORY SET IN R1
  241.     SH    R1,=AL2(LBUFFS) REDUCE ALLOCATED MEMORY FOR BUFFERS
  242.     BNP   E02
  243.     SVC   GETMAIN        ALLOCATE IT
  244.     ST    R2,ASCB        ALLOCATE AREA FOR SCREEN
  245.     SH    R1,=AL2(24*LSCB) REDUCE ALLOCATED BY SCB'S
  246.     BNP   E02
  247.     AH    R2,=AL2(23*LSCB)
  248.     ST    R2,MAXSCB      ADDR OF LAST SCB
  249.     AH    R2,=AL2(LSCB)  UPDATE R2 TO START TO TEXT AREA
  250.     ST    R1,GFQEL       SET LENGTH OF EXTENDED STORAGE
  251.     ST    R2,GFQEA       SET ADDRESS
  252.     ST    R2,MINMEM      SAVE LOW LIMIT
  253.     AR    R2,R1
  254.     ST    R2,MAXMEM      SAVE MAX LIMIT
  255.     SR    R0,R0
  256.     D     R0,=A(LLB)
  257.     ST    R1,FMAXLINE    SET MAX LINES POSSIBLE
  258.     LA    R1,F1SC
  259.     LA    R2,F1SCEND-F1SC
  260.     SVC   EBCASC
  261.     L     R1,=A(F2SC)
  262.     LA    R2,F2SCEND-F2SC
  263.     SVC   EBCASC
  264.     L     R14,INITSV14
  265.     BR    R14
  266.     TITLE 'LOADFILE - READ FILE INTO LB CHAIN IN EXTENDED MEMORY'
  267. LOADFILE EQU   *
  268.     ST    R14,LOADSV14
  269.     MVI   EOF1,FALSE
  270.     MVC   STATNAME,DSN1    MOVE DSN TO STATUS LINE
  271.     LA    R3,STATLINE
  272.     LA    R4,L'STATLINE
  273.     BAL   R14,PUTSTAT      PRINT ENTIRE STATUS LINE ONCE
  274.     BAL   R14,KEYSTATS
  275.     BAL   R14,CLEAR
  276.     LA    R2,F1SC
  277.     L     R3,=A(F1SCEND)
  278.     BAL   R14,HELPSCRN
  279.     LA    R2,SYSUT1
  280.     SVC   SEARCH
  281.     CLM   R0,1,=X'00'  DOES FILE EXIST
  282.     BNE   NULLFILE     NO, GO BUILD NEW FILE
  283.     LA    R2,SYSUT1
  284.     SVC   OPEN
  285.     MVC   WLBPREV,=A(0)
  286.     L     R12,MINMEM
  287.     USING LB,R12
  288.     LA    R1,WLBLINE
  289.     LA    R2,SYSUT1
  290.     ST    R12,GLBFIRST
  291.     LA    R5,100
  292. LOADLOOP EQU   *
  293.     LA    R3,LLB(R12)
  294.     ST    R3,WLBNEXT
  295.     CL    R3,MAXMEM            VERIFY NOT OUT OF MEMORY
  296.     BNL   LOADERR
  297.     SVC   GET                  READ RECORD INTO LB
  298.     CLI   WLBLINE,ASCTAB       IS THERE A TAB TO COL. 10
  299.     BNE   LOADSKPT
  300.     MVC   SAVETEXT,WLBLINE+1
  301.     MVC   WLBLINE(9),=9AL1(ASCBLK)   REPLACE TAB WITH 9 SPACES
  302.     MVC   WLBLINE+9(L'WLBLINE-9),SAVETEXT
  303. LOADSKPT EQU   *
  304.     MVC   LB(LLB),WLB   MOVE LB TO MEMORY
  305.     ST    R12,WLBPREV
  306.     LR    R12,R3
  307.     BCT   R5,LOADLOOP
  308.     AP    PTOTAL,=P'100'
  309.     MVC   STATREC,=X'402020202020'
  310.     ED    STATREC,PTOTAL
  311.     LA    R3,STATREC
  312.     LA    R4,L'STATREC
  313.     BAL   R14,PUTSTAT
  314.     ZAP   PLSTLINE,PTOTAL
  315.     BAL   R14,PUTPCT
  316.     LA    R1,WLBLINE
  317.     LA    R2,SYSUT1
  318.     LA    R5,100
  319.     B     LOADLOOP
  320. NULLFILE EQU   *
  321.     MVI   KBINS,INSSTATE  START IN INSERT FOR NEW FILE
  322.     BAL   R14,NEWFILE
  323.     LA    R1,=CL20'NEW FILE'
  324.     BAL   R14,PUTMSG
  325.     B     LOADSKPC
  326. LOADERR  EQU   *
  327.     MVI   EOJ,TRUE         SHUT DOWN IF LOAD ERR
  328.     LA    R1,=CL20'* OUT OF MEMORY *'
  329.     BAL   R14,PUTMSG
  330.     BAL   R14,GETKEY
  331.     B     LOADSKPC
  332. EOFUT1   EQU   *                NORMAL END OF FILE ON INPUT
  333.     CVD   R5,PWORK
  334.     ZAP   PLSTLINE,=P'100'
  335.     SP    PLSTLINE,PWORK
  336.     AP    PLSTLINE,PTOTAL  CALC TOTAL LINES LOADED
  337.     L     R12,WLBPREV
  338.     MVC   LBNEXT,=A(0) RESET NEXT IN LAST LB
  339.     ST    R12,GLBLAST
  340.     ST    R3,GFQEA         UPDATE FREE MEMORY START
  341.     L     R4,MAXMEM
  342.     SR    R4,R3
  343.     ST    R4,GFQEL         UPDATE REMAINING FREE LENGTH
  344.     ZAP   PCUR,=P'1'
  345.     MVC   GLBCUR,GLBFIRST  RESET TO FIRST LB
  346.     LA    R2,SYSUT1
  347.     SVC   CLOSE
  348.     BAL   R14,PUTPCT
  349. LOADSKPC EQU   *
  350.     BAL   R14,AUDITMS
  351.     L     R14,LOADSV14
  352.     BR    R14
  353.     TITLE 'EDITFILE ENTER FULL SCREEN MODE TO BROWZE/CHANGE FILE'
  354. EDITFILE EQU   *
  355.     ST    R14,EDITSV14
  356.     LA    R1,=CL20'EDIT'
  357.     BAL   R14,PUTMSG
  358.     BAL   R14,DISPLAY    DISPLAY 24 LINES PLUS STATUS
  359. EDITLOOP EQU   *
  360.     BAL   R14,GETKEY      GET NEXT KEY INPUT
  361.     SR    R2,R2           CLEAR FUNCTION CODE REG.
  362.     TRT   KEY,KEYTAB
  363.     L     R0,WAITLOOP     LOOP ON BCT FOR COUNT IN WAITLOOP
  364.     BCT   R0,*
  365.     L     R15,KRTAB(R2)
  366.     BALR  R14,R15         PROCESS KEY
  367.     BAL   R14,AUDITSCB    AUDIT SCB'S IF AUDIT ON
  368.     CLI   EOJ,TRUE        IS IT END OF JOB (ESCAPE KEY)
  369.     BNE   EDITLOOP
  370.     L     R14,EDITSV14
  371.     BR    R14
  372.     TITLE 'SAVEFILE RENAME OLD FILE AND WRITE NEW FILE IF CHANGED'
  373. SAVEFILE EQU   *
  374.     ST    R14,SAVESV14
  375.     ST    R5,SAVEROW
  376.     ST    R6,SAVECOL
  377.     ST    R7,SAVESCB
  378.     LA    R1,=CL20'SAVING'
  379.     BAL   R14,PUTMSG
  380.     BAL   R14,UPDATE    UPDATE FILE WITH ANY CHANGES ON SCREEN
  381.     CLI   FILEMOD,TRUE  HAS FILE CHANGED
  382.     BNE   SAVESKIP      NO, EXIT NOW
  383.     MVI   EOF1,FALSE
  384.     MVI   SYSUT1+(MACRF-IHADCB),C'P'  CHANGE DCB FROM GET TO PUT
  385.     CLI   FIRSTSAV,TRUE
  386.     BNE   SAVESKPR       IF NOT FIRST SAVE, SKIP RENAME
  387.     MVI   FIRSTSAV,FALSE
  388.     LA    R2,SYSUT1
  389.     USING IHADCB,R2
  390.     SVC   SEARCH
  391.     CLM   R0,1,=X'00'
  392.     BNE   SAVESKPR       IF NO OLD FILE, SKIP
  393.     L     R1,ATYPE1
  394.     MVC   SAVETYPE,1(R1) SAVE ORIG. TYPE
  395.     MVC   1(3,R1),=C'BAK'
  396.     SVC   SEARCH
  397.     CLM   R0,1,=X'00'
  398.     BNE   SKPDEL         IF NO BKP, SKIP DELETE
  399.     SVC   DELETE         DELETE OLD BACKUP IF PRESENT
  400. SKPDEL   EQU   *
  401.     MVC   REN1(64),DSN1  COPY FILE NAME TO RENAME
  402.     L     R1,ATYPE1
  403.     MVC   1(3,R1),SAVETYPE  RESTORE OLD FILE NAME
  404.     SVC   RENAME         RENAME OLD FILE TO BKP
  405. SAVESKPR EQU   *
  406.     LA    R2,SYSUT1
  407.     SVC   OPEN
  408.     L     R12,GLBFIRST
  409.     USING LB,R12
  410.     LA    R5,100
  411.     ZAP   PTOTAL,=P'0'
  412.     XC    FINDKEY,FINDKEY
  413.     MVI   FINDKEY+ASCCR,X'FF'
  414. SAVELOOP EQU   *
  415.     LTR   R12,R12
  416.     BZ    SAVEEXIT
  417.     MVC   WLB(LLB),LB   MOVE NEXT LB TO WORKING STORAGE
  418.     MVC   WLBLINE+L'WLBLINE(2),=AL1(ASCCR,ASCLF) RESET PAD
  419.     TRT   WLBLINE(81),FINDKEY  FIND END OF RECORD
  420.     LA    R2,1(R1)
  421.     S     R2,=A(WLBLINE)
  422. SAVEBLKL EQU   *
  423.     BCTR  R1,0                 BACKUP TO FIRST NON-BLANK
  424.     CLI   0(R1),ASCBLK
  425.     BNE   SAVEBLKE
  426.     BCT   R2,SAVEBLKL
  427. SAVEBLKE EQU   *
  428.     MVC   1(2,R1),=AL1(ASCCR,ASCLF)   PUT CR,LF AFTER LAST CHAR
  429.     LA    R1,WLBLINE
  430.     CLI   ALC,TRUE                    IS FILE TYPE ALC
  431.     BNE   SAVESKPT
  432.     CLC   WLBLINE(9),=9AL1(ASCBLK)    ARE THERE 9 LEADING BLANKS
  433.     BNE   SAVESKPT
  434.     MVI   WLBLINE+8,ASCTAB            INSERT TAB
  435.     LA    R1,WLBLINE+8                WRITE FROM TAB
  436. SAVESKPT EQU   *
  437.     LA    R2,SYSUT1
  438.     SVC   PUT               PUT RECORD
  439.     L     R12,WLBNEXT
  440.     BCT   R5,SAVELOOP       REPEAT 100 TIMES
  441.     AP    PTOTAL,=P'100'
  442.     MVC   STATREC,=X'402020202020'
  443.     ED    STATREC,PTOTAL
  444.     LA    R3,STATREC
  445.     LA    R4,L'STATREC
  446.     BAL   R14,PUTSTAT       PRINT RECORD # EVERY 100 RECORDS
  447.     LA    R5,100
  448.     B     SAVELOOP
  449. SAVEEXIT EQU   *
  450.     LA    R2,SYSUT1
  451.     SVC   CLOSE
  452.     MVI   FILEMOD,FALSE
  453. SAVESKIP EQU   *
  454.     L     R5,SAVEROW
  455.     L     R6,SAVECOL
  456.     L     R7,SAVESCB
  457.     L     R14,SAVESV14
  458.     BR    R14
  459.     TITLE 'DISPLAY - DISPLAY 24 LINES AT CURRENT POINT IN FILE'
  460. DISPLAY  EQU   *
  461.     ST    R14,DISPSV14
  462.     MVC   SAVBLKLB,BLKLABEL  SAVE BLKLABEL MODE
  463.     BAL   R14,UPDATE     UPDATE SCREEN LINES IN EXTENDED STORAGE
  464.     BAL   R14,CLEAR   CLEAR DISPLAY AND RESET CURSOR
  465.     L     R12,GLBCUR  R12=A(CURRENT LB IN EXTENDED MEMORY)
  466.     LTR   R12,R12
  467.     BNZ   DISPOK
  468.     BAL   R14,NEWFILE INITIALIZE EMPTY FILE
  469.     L     R12,GLBCUR
  470. DISPOK   EQU   *
  471.     SR    R5,R5       RESET ROW
  472.     USING LB,R12
  473.     L     R7,ASCB     SCREEN TABLE
  474.     USING SCB,R7
  475. DISPLINE EQU   *
  476.     LTR   R12,R12     IS LB ADDRESS GT 0
  477.     BZ    DISPEXIT    NO, GO EXIT
  478.     ST    R12,SCBADDR SAVE ADDRESS OF LB
  479.     MVC   SCBLB(LLB),LB    MOVE CURRENT LINE TO SCB
  480.     MVI   SCBMOD,FALSE     SET MODIFY FALSE
  481.     SR    R3,R3            SET STARTING COL.
  482.     BAL   R14,PUTLINE
  483.     MVI   BLKLABEL,FALSE   TEMP TURN OFF BLKLABEL AFTER FIRST
  484. NEXTLINE EQU   *                LINE TO ONLY MARK FIRST LINE
  485.     ST    R5,LASTROW       SET LAST ROW
  486.     ST    R7,LASTSCB       SET LAST SCB ADDR
  487.     LA    R0,X'0100'
  488.     SVC   KEYBOARD
  489.     STCM  R0,4,KEY         PUT LOW FLAGS BYTE IN KEY
  490.     TM    KEY,X'40'        IS THERE A KEY WAITING
  491.     BZ    DISPEXIT         YES, EXIT NOW WITH SHORT SCREEN
  492.     LA    R5,X'100'(R5)    INCR ROW
  493.     LA    R6,X'00'         RESET COL
  494.     L     R12,SCBNEXT      ADDRESS OF NEXT LB
  495.     LA    R7,LSCB(R7)      INCR SCREEN CONTROL BLOCK
  496.     CL    R5,MAXROW
  497.     BNH   DISPLINE
  498. DISPEXIT EQU   *
  499.     MVC   BLKLABEL,SAVBLKLB RESTORE BLKLABEL MODE
  500.     LA    R5,0            RESET ROW,COL TO 0,0
  501.     LA    R6,0
  502.     L     R7,ASCB         RESET SCB ADDRESS
  503.     ZAP   PCURLINE,PCUR
  504.     ZAP   PCOL,=P'1'
  505.     BAL   R14,SETCUR      RESET CURSOR
  506.     L     R14,DISPSV14
  507.     BR    R14
  508.     TITLE 'SETCUR - SET CURSOR ON NEW DISPLAY'
  509. SETCUR   EQU   *
  510.     ST    R14,SETCSV14
  511.     CLC   PCURLINE,PCURLAST
  512.     BE    SCSKPREC
  513.     MVC   PCURLAST,PCURLINE
  514.     MVC   STATREC,=X'402020202120'
  515.     ED    STATREC,PCURLINE
  516.     LA    R3,STATREC
  517.     LA    R4,L'STATREC
  518.     BAL   R14,PUTSTAT
  519. SCSKPREC EQU   *
  520.     CLC   PCOL,PCOLLAST
  521.     BE    SCSKPCOL
  522.     MVC   PCOLLAST,PCOL
  523.     MVC   STATCOL,=X'40202120'
  524.     ED    STATCOL,PCOL
  525.     LA    R3,STATCOL
  526.     LA    R4,L'STATCOL
  527.     BAL   R14,PUTSTAT
  528. SCSKPCOL EQU   *
  529.     LA    R15,0(R5,R6)
  530.     LA    R0,X'0200'      AH=2 SET CURSOR
  531.     LA    R1,0            BH=0 PAGE
  532.     SVC   VIDEO
  533.     L     R14,SETCSV14
  534.     BR    R14
  535.     TITLE 'NEWFILE - INITIALIZE NEW FILE IN MEMORY'
  536. NEWFILE  EQU   *
  537.     ST    R14,NEWFSV14
  538.     BAL   R14,GETNEWLB
  539.     LTR   R15,R15
  540.     BZ    E03
  541.     L     R12,ANEWLB
  542.     ST    R12,GLBCUR
  543.     ST    R12,GLBFIRST
  544.     ST    R12,GLBLAST
  545.     ZAP   PCUR,=P'1'
  546.     ZAP   PLSTLINE,=P'1'
  547.     MVC   WLBPREV,=A(0)
  548.     MVC   WLBNEXT,=A(0)
  549.     MVC   WLBLINE,=AL1(ASCCR,ASCLF)
  550.     BAL   R14,CHKADDR
  551.     MVC   LB(LLB),WLB   INITIALIZE EMPTY LINE IN MEMORY
  552.     L     R14,NEWFSV14
  553.     SR    R15,R15
  554.     BR    R14
  555.     TITLE 'PUTLINE - DISPLAY CURRENT LINE'
  556. *
  557. * R3 = STARTING COLUMN
  558. *
  559. * IF IN MARKING MODE, USE REVERSE VIDEO AND SET ENDING BLOCK
  560. *
  561. PUTLINE  EQU   *
  562.     ST    R14,PUTLSV14
  563.     IC    R0,ATTRIB
  564.     STC   R0,ATTSAVE
  565.     CLI   BLKLABEL,MARK
  566.     BNE   PUTLINE1
  567.     MVC   BLK2LB,SCBADDR  UPDATE ENDING BLOCK
  568.     SLL   R0,4
  569.     LR    R1,R0
  570.     N     R1,=X'00000070' BG=FG  (TURN OFF HIGH INTENSITY/BLINK)
  571.     SRL   R0,8
  572.     N     R0,=X'00000007' FG=BG
  573.     OR    R1,R0
  574.     STC   R1,ATTRIB
  575.     OI    ATTRIB,X'08'    TURN ON INTENSITY FOR REVVERSE FG
  576. PUTLINE1 EQU   *
  577. ****************************************************************
  578. *DISPCHAR EQU   *                                              *
  579. *        CLI   0(R2),ASCBLK IS IT END OF LINE                  *
  580. *        BL    DSLNEXIT                                        *
  581. * MICRO  LA    R0,X'0200'  AH=2 SET CURSOR                     *
  582. * CODED  LA    R1,0        BH=0 PAGE                           *
  583. * AS     LA    R15,0(R5,R3) DH=ROW,DL=COL                      *
  584. * PC/370 SVC   VIDEO                                           *
  585. * SVC 24 LA    R0,X'0900'  AH=9                                *
  586. * FOR    LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE) *
  587. * SPEED  IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.                *
  588. * ON     LA    R14,1       CX=(COUNT OF CHAR TO WRITE)         *
  589. * MOST   IC    R0,0(R2)    AL=CHAR                             *
  590. * FREQ.  SVC   VIDEO       DISPLAY CHAR                        *
  591. * VIDEO  LA    R3,1(R3)    INCR COL                            *
  592. * FUNCT. LA    R2,1(R2)    INCR CHAR                           *
  593. *        B     DISPCHAR    REPEAT FOR LINE                     *
  594. *DSLNEXIT EQU   *                                              *
  595. ****************************************************************
  596.     LA    R2,SCBLINE(R3)
  597.     SR    R1,R1
  598.     IC    R1,ATTRIB    PUT BH=0 AND BL=ATTIRBUTE IN R1
  599.     LA    R15,0(R5,R3) PUT ROW AND COL IN R15
  600. *****************************************************************
  601.     SVC   PRINTTXT     PRINT LINE AT (R2) AT (R15) ON SCREEN
  602. *****************************************************************
  603.     STC   R15,SCBCOL   UPDATE ENDING COL.  (NOTE SVC USES R15
  604.     SR    R1,R1                             INSETEAD OF R3)
  605.     IC    R1,SCBCOL
  606.     LA    R1,SCBLINE(R1)
  607.     MVC   0(2,R1),=AL1(ASCCR,ASCLF)    ADD CR,LF
  608.     LA    R0,X'0200'  AH=2 SET CURSOR
  609.     LA    R1,0        BH=0 PAGE
  610.     LA    R15,0(R5,R6) DH=ROW,DL=COL
  611.     SVC   VIDEO
  612.     MVC   ATTRIB,ATTSAVE  RESET COLORS
  613.     L     R14,PUTLSV14
  614.     BR    R14
  615.     TITLE 'PUTMSG - DISPLAY 20 CHAR MSG AT R1'
  616. PUTMSG   EQU   *
  617.     MVC   STATMSG,0(R1)
  618.     LA    R3,STATMSG
  619.     LA    R4,L'STATMSG
  620.     B     PUTSTAT
  621.     TITLE 'PUTSTAT - DISPLAY DATA ON STATUS LINE'
  622. *
  623. * R3 = START OF TEXT IN STATUS LINE
  624. * R4 = LENGTH OF TEXT
  625. *
  626. PUTSTAT  EQU   *
  627.     ST    R14,PUTSSV14
  628.     LR    R1,R3
  629.     LR    R2,R4
  630.     SVC   EBCASC
  631.     LR    R2,R3
  632.     SR    R1,R1
  633.     STC   R1,0(R3,R4)  SET EOR FOR PRINTTXT
  634.     IC    R1,ATTRIB
  635.     LR    R15,R3
  636.     S     R15,=A(STATLINE-STATRC0)
  637.     SVC   PRINTTXT
  638.     LA    R0,X'0200'   AH=2 SET CURSOR
  639.     LA    R1,0         BH=0 PAGE
  640.     LA    R15,0(R5,R6) DH=ROW,DL=COL
  641.     SVC   VIDEO
  642.     L     R14,PUTSSV14
  643.     BR    R14
  644.     TITLE 'NEWSTAT - REFRESH STATUS LINE WITH CURRENT ATTRIBUTE'
  645. NEWSTAT  EQU   *
  646.     ST    R14,PUTSSV14
  647.     LA    R2,STATLINE
  648.     LA    R1,L'STATLINE
  649. NEWSTAT1 EQU   *
  650.     CLI   0(R2),ASCBLK
  651.     BNL   NEWSTAT2
  652.     MVI   0(R2),ASCBLK  CLEAR OUT INDIVIDUAL FIELD STOPS
  653. NEWSTAT2 EQU   *
  654.     LA    R2,1(R2)
  655.     BCT   R1,NEWSTAT1
  656.     SR    R1,R1
  657.     IC    R1,ATTRIB
  658.     LA    R2,STATLINE
  659.     L     R15,=A(STATRC0)
  660.     SVC   PRINTTXT
  661.     LA    R0,X'0200'   AH=2 SET CURSOR
  662.     LA    R1,0         BH=0 PAGE
  663.     LA    R15,0(R5,R6) DH=ROW,DL=COL
  664.     SVC   VIDEO
  665.     L     R14,PUTSSV14
  666.     BR    R14
  667.     TITLE 'PUTPCT - UPDATE % OF MEMORY CAPACITY IN USE'
  668. PUTPCT   EQU   *
  669.     ST    R14,PPCTSV14
  670.     ZAP   PWORK,PLSTLINE
  671.     CVB   R1,PWORK
  672.     MH    R1,=H'100'
  673.     SR    R0,R0
  674.     D     R0,FMAXLINE
  675.     CVD   R1,PWORK
  676.     MVC   STATPCT,=X'40202120'
  677.     ED    STATPCT,PWORK+6
  678.     LA    R3,STATPCT
  679.     LA    R4,L'STATPCT+1
  680.     MVI   STATPCT+L'STATPCT,C'%'
  681.     BAL   R14,PUTSTAT
  682.     L     R14,PPCTSV14
  683.     BR    R14
  684.     TITLE 'CLEAR - CLEAR SCREEN AND SET CURSOR TO UPPER LEFT'
  685. CLEAR    EQU   *
  686.     ST    R14,CLRSV14
  687.     LA    R0,X'0200'  AH=2 SET CURSOR
  688.     LA    R1,0        BH=0 PAGE
  689.     LA    R15,X'0000' DH=ROW,DL=COL
  690.     SVC   VIDEO       SET CURSOR TO UPPER LEFT CORNER
  691.     LA    R0,X'0920'  AH=10, AL=SPACE
  692.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  693.     IC    R1,ATTRIB
  694.     LA    R14,24*80   CHARACTERS ON DATA LINES
  695.     SVC   VIDEO       CLEAR DATA LINES
  696.     L     R14,CLRSV14
  697.     BR    R14
  698.     TITLE 'GETKEY - GET NEXT KEY INPUT'
  699. GETKEY   EQU   *
  700.     ST    R14,GETKSV14
  701.     MVC   LASTKEY,KEY     SAVE LAST KEY
  702.     CLI   KSMODE,KSREAD
  703.     BE    KSGET
  704. CHKNOW   EQU   *
  705.     LA    R0,X'0100'
  706.     SVC   KEYBOARD
  707.     STCM  R0,4,KEY        PUT LOW FLAGS BYTE IN KEY
  708.     TM    KEY,X'40'       IS THERE A KEY WAITING
  709.     BZ    GETNOW          YES, GO GET KEY NOW
  710.     BAL   R14,KEYSTATS    NO, GO UPDATE KEY STATUS FIRST
  711.     B     CHKNOW
  712. GETNOW   EQU   *
  713.     LA    R0,X'0000'
  714.     SVC   KEYBOARD        GET KEY FROM KEYBOARD BIA BIOS
  715.     STC   R0,KEY
  716.     CLI   KEY,X'00'       IS IT NULL CODE
  717.     BE    KEYEXT          YES, GET EXTENDED CODE
  718.     CLI   KEY,X'80'       IS IT ASCII 0-127
  719.     BL    KEYOK           YES, OK
  720.     MVI   KEY,X'00'       NO,  MAKE IT NULL
  721.     B     KEYOK
  722. KEYEXT   EQU   *
  723.     STCM  R0,2,KEY        STORE AH EXTENDED CODE
  724.     OI    KEY,X'80'       FORCE EXTENDED CODES TO 128+
  725. KEYOK    EQU   *
  726.     CLI   KSMODE,KSWRITE  IS KEYBOARD FILE BEING WRITTEN
  727.     BNE   GETKEXIT         NO, EXIT
  728. KSPUT    EQU   *               YES, PUT KEY
  729.     L     R1,KSNEXT
  730.     MVC   0(1,R1),KEY     MOVE KEY TO KS OUTPUT RECORD
  731.     LA    R1,1(R1)
  732.     ST    R1,KSNEXT
  733.     CL    R1,=A(KSRECEND)
  734.     BL    GETKEXIT
  735.     LA    R1,KSREC
  736.     ST    R1,KSNEXT       RESET NEXT POINTER
  737.     LA    R2,SYSUT2
  738.     SVC   PUT             WRITE KS RECORD
  739.     B     GETKEXIT
  740. KSGET    EQU   *
  741.     L     R1,KSNEXT
  742.     LA    R1,1(R1)
  743.     ST    R1,KSNEXT
  744.     CL    R1,=A(KSRECEND)
  745.     BL    KSGETOK
  746.     LA    R1,KSREC
  747.     ST    R1,KSNEXT
  748.     LA    R2,SYSUT2
  749.     SVC   GET             READ KS RECORD
  750. KSGETOK  EQU   *
  751.     MVC   KEY,0(R1)
  752. GETKEXIT EQU   *
  753.     L     R14,GETKSV14
  754.     BR    R14
  755.     TITLE 'AUDITSCB - AUDIT SCB'S AGAINST LB'S'
  756. AUDITSCB EQU   *
  757.     CLI   AUDIT,TRUE
  758.     BNER  R14
  759.     STM   R0,R3,SAVER0R3
  760.     LA    R0,0            ERR 0
  761.     LTR   R5,R5
  762.     BM    AUDITBUG                ROW LT 0
  763.     CL    R5,MAXROW
  764.     BH    AUDITBUG                ROW GT 23
  765.     LA    R0,10           ERR 10
  766.     LA    R1,LASTROW
  767.     LA    R2,LASTSCB
  768.     CL    R5,LASTROW
  769.     BH    AUDITBUG                ROW GT LASTROW
  770.     CL    R7,LASTSCB
  771.     BH    AUDITBUG                ASCB GT LASTSCB
  772.     LA    R0,11           ERR 11
  773.     LR    R1,R5
  774.     SRL   R1,8
  775.     MH    R1,=AL2(LSCB)
  776.     A     R1,ASCB
  777.     CLR   R1,R7                   ROW NE ASCB
  778.     BNE   AUDITBUG
  779.     L     R1,ASCB
  780.     SR    R2,R2
  781. AUDITL   EQU   *
  782.     L     R12,SCBADDR-SCB(R1)
  783.     MVC   WLB(8),LB
  784.     CLC   SCBLB-SCB(8,R1),WLB   CHECK LB POINTERS
  785.     LA    R0,1            ERR 1
  786.     BNE   AUDITBUG              SCB PREV/NEXT NE LB PREV/NEXT
  787.     LR    R3,R1
  788.     LA    R2,ROWINC(R2)
  789.     LA    R1,LSCB(R1)
  790.     CL    R2,LASTROW
  791.     BH    AUDITE
  792.     CLC   SCBNEXT-SCB(4,R3),SCBADDR-SCB(R1)
  793.     LA    R0,2            ERR 2
  794.     BNE   AUDITBUG             SCBNEXT EQ SCBADDR OF NEXT
  795.     CLC   SCBPREV-SCB(4,R1),SCBADDR-SCB(R3)
  796.     BNE   AUDITBUG             SCBPREV EQ SCBADDR OF PREV
  797.     B     AUDITL
  798. AUDITE   EQU   *
  799.     LM    R0,R3,SAVER0R3
  800.     BR    R14
  801. AUDITBUG EQU   *               ENTER PC/370 DEBUG WITH ERR IN R0
  802.     SVC   TRACE
  803.     DC    C'BUG '
  804.     B     *
  805.     TITLE 'AUDITMS - AUDIT MAIN STORAGE LBS'
  806. AUDITMS  EQU   *
  807.     CLI   AUDIT,TRUE
  808.     BNER  R14
  809.     STM   R0,R3,SAVER0R3
  810.     ZAP   PCHKLINE,=P'0'
  811.     MVC   WLBADDR,GLBFIRST
  812.     L     R12,WLBADDR
  813.     LTR   R12,R12
  814.     BZ    AUDITMSE
  815.     MVC   WLB(LLB),LB
  816.     LA    R0,3            ERR 3
  817.     LA    R1,WLBADDR
  818.     CLC   WLBPREV,=A(0)
  819.     BNE   AUDITBUG             FIRST LBPREV EQ 0
  820.     LA    R0,4            ERR 4
  821.     LA    R3,TLBADDR
  822. AUDITMSL EQU   *
  823.     AP    PCHKLINE,=P'1'
  824.     MVC   TLBADDR,WLBNEXT
  825.     L     R12,TLBADDR
  826.     LTR   R12,R12
  827.     BZ    AUDITMSE
  828.     MVC   TLB(LLB),LB
  829.     CLC   WLBADDR,TLBPREV
  830.     BNE   AUDITBUG             LP(I) EQ LPREV(I+1)
  831.     MVC   WLBADDR,TLBADDR
  832.     MVC   WLB(LLB),TLB
  833.     B     AUDITMSL
  834. AUDITMSE EQU   *
  835.     LA    R0,5           ERR 5
  836.     L     R1,WLBADDR
  837.     L     R3,GLBLAST
  838.     CLC   WLBADDR,GLBLAST
  839.     BNE   AUDITBUG            GLBLAST EQ LP(LAST)
  840.     LA    R0,6           ERR 6
  841.     LA    R1,PCHKLINE
  842.     LA    R3,PLSTLINE
  843.     CP    PCHKLINE,PLSTLINE
  844.     BNE   AUDITBUG            PLSTLINE EQ LB COUNT
  845.     LM    R0,R3,SAVER0R3
  846.     BR    R14
  847.     TITLE 'TERMKSF - FLUSH AND CLOSE KSF FILE IF ACTIVE'
  848. TERMKSF  EQU   *
  849.     ST    R14,TERMSV14
  850.     CLI   KSMODE,KSOFF    IS KEYBOARD FILE IN USE
  851.     BE    TERMKSFE        NO, EXIT NOW
  852.     CLI   KSMODE,KSWRITE  IS IT WRITE
  853.     BNE   TERMKSFC        NO, GO CLOSE IT
  854.     L     R1,KSNEXT
  855.     CL    R1,=A(KSREC)    IS THERE DATA IN LAST RECORD
  856.     BE    TERMKSFC        NO, GO CLOSE IT
  857.     LA    R1,KSREC
  858.     LA    R2,SYSUT2
  859.     SVC   PUT             YES, WRITE LAST KS RECORD
  860. TERMKSFC EQU   *
  861.     LA    R2,SYSUT2
  862.     SVC   CLOSE           CLOSE KS FILE
  863. TERMKSFE EQU   *
  864.     L     R14,TERMSV14
  865.     BR    R14
  866.     TITLE 'KEYSTATS - UPDATE CAPS, INSERT, NUMLOCK STATUS'
  867. KEYSTATS EQU   *
  868.     ST    R14,KEYSSV14
  869.     LA    R0,X'0200'  AH=2 RETURN SHIFT STATUS
  870.     SVC   KEYBOARD    READ SHIFT STATUS INTO AL (TECH. A-26)
  871. ******
  872. *
  873. *  NOTE INS STATE IS TOGGLED BY KEY ROUTINE ALWAYS STARTING IN OFF
  874. *  STATE RATHER THAN USING MS-DOS TOGGLED STATUS WHICH MAY OR MAY
  875. *  NOT BE OFF AT START OF PROGRAM.  (USER MAY CHANGE OPTION. IF YOU
  876. *  DO REMEMBER TO DISABLE TOGGLE IN KRINS ROUTINE.)
  877. *
  878. *        STC   R0,KBINS
  879. *        NI    KBINS,INSSTATE
  880. *
  881. *****
  882.     STC   R0,KBCAP         SET CAP STATUS
  883.     NI    KBCAP,CAPSTATE
  884.     STC   R0,KBNUM         SET NUM STATUS
  885.     NI    KBNUM,NUMSTATE
  886. KEYSINS  EQU   *
  887.     CLC   KBINS,KBINSLST
  888.     BE    KEYSCAP
  889.     CLI   KBINS,INSSTATE
  890.     MVC   STATINS,=C'INS'
  891.     BE    KEYSINSU
  892.     MVC   STATINS,=C'   '
  893. KEYSINSU EQU   *
  894.     MVC   KBINSLST,KBINS
  895.     LA    R3,STATINS
  896.     LA    R4,L'STATINS
  897.     BAL   R14,PUTSTAT
  898. KEYSCAP  EQU   *
  899.     CLC   KBCAP,KBCAPLST
  900.     BE    KEYSNUM
  901.     CLI   KBCAP,CAPSTATE
  902.     MVI   KBCAP,CAPSTATE
  903.     MVC   STATCAP,=C'CAP'
  904.     BE    KEYSCAPU
  905.     MVI   KBCAP,0
  906.     MVC   STATCAP,=C'   '
  907. KEYSCAPU EQU   *
  908.     MVC   KBCAPLST,KBCAP
  909.     LA    R3,STATCAP
  910.     LA    R4,L'STATCAP
  911.     BAL   R14,PUTSTAT
  912. KEYSNUM  EQU   *
  913.     CLC   KBNUM,KBNUMLST
  914.     BE    KEYSEXIT
  915.     CLI   KBNUM,NUMSTATE
  916.     MVI   KBNUM,NUMSTATE
  917.     MVC   STATNUM,=C'NUM'
  918.     BE    KEYSNUMU
  919.     MVI   KBNUM,0
  920.     MVC   STATNUM,=C'   '
  921. KEYSNUMU EQU   *
  922.     MVC   KBNUMLST,KBNUM
  923.     LA    R3,STATNUM
  924.     LA    R4,L'STATNUM
  925.     BAL   R14,PUTSTAT
  926. KEYSEXIT EQU   *
  927.     L     R14,KEYSSV14
  928.     BR    R14
  929.     TITLE 'KR - KEY CONTROL ROUTINES'
  930. *
  931. * ALL ROUTINES STARTING WITH KR..... ARE ACCESSED VIA BALR FROM EDIT
  932. * BASED ON USE OF EXTENDED ASCII KEYBOARD INPUT BYTE USED AS INDEX
  933. * INTO KEYTAB TO OFFSET TO KRTAB ADDRESS TABLE POINTER TO KR ROUTINE.
  934. * THIS IDEXING SCEME CAN HANDLE UP TO 63 KR ROUTINES.
  935. *
  936. KRUND    EQU   *              PROCESS UNDEFINED KEY
  937.     BR    R14
  938. KRCHAR   EQU   *              PROCESS ASCII CHARACTER
  939.     ST    R14,KRSV14
  940.     BAL   R14,KRSETCHR
  941.     LA    R6,1(R6)       INCR COL
  942.     AP    PCOL,=P'1'
  943.     MVC   STATCOL,=X'40202020'
  944.     ED    STATCOL,PCOL
  945.     LA    R3,STATCOL+2
  946.     LA    R4,2
  947.     BAL   R14,PUTSTAT
  948.     MVC   PCOLLAST,PCOL
  949.     CH    R6,=H'80'      WRAP IF END OF LINE
  950.     BL    KRCHARS2
  951.     LA    R6,0           RESET COL
  952.     ZAP   PCOL,=P'1'
  953.     LA    R5,ROWINC(R5)  INCR ROW
  954.     AP    PCURLINE,=P'1'
  955.     LA    R7,LSCB(R7)    INCR SCB LINE
  956.     CL    R5,LASTROW     WRAP IF LAST LINE
  957.     BNH   KRCHARS1
  958.     LA    R5,0           RESET ROW
  959.     ZAP   PCURLINE,PCUR
  960.     L     R7,ASCB        RESET SCB
  961. KRCHARS1 EQU   *              UPDATE CURSOR ON SCREEN
  962.     BAL   R14,SETCUR
  963. KRCHARS2 EQU   *
  964.     LA    R0,X'0200'     AH=2 SET CURSOR
  965.     LA    R1,0           BH=0 PAGE
  966.     LA    R15,0(R5,R6)   DH=ROW,DL=COL
  967.     SVC   VIDEO
  968.     L     R14,KRSV14
  969.     BR    R14
  970. KRSETCHR EQU   *              STORE KEY AT CURSOR
  971.     ST    R14,SCHRSV14
  972.     MVI   SCBMOD,TRUE    SET MOD SWITCH FOR CURRENT LINE
  973.     MVI   SCRMOD,TRUE    SET MOD SWITCH FOR CURRENT SCREEN
  974.     CLM   R6,1,SCBCOL    IS NEW CHAR PAST END OF LINE
  975.     BL    KRCHARCI       NO, GO CHECK INSERT MODE
  976.     SR    R2,R2
  977.     IC    R2,SCBCOL      R2 = OLD COL
  978.     LR    R1,R6
  979.     SR    R1,R2
  980.     LA    R2,SCBLINE(R2)
  981.     MVI   0(R2),ASCBLK   INIT PAD
  982.     EX    R1,MVCPAD      EXTEND PAD TO NEW COLUMN
  983.     LA    R1,1(R6)
  984.     STC   R1,SCBCOL      SET NEW ENDING COL
  985.     LA    R2,SCBLINE(R1)
  986.     MVC   0(2,R2),=AL1(ASCCR,ASCLF) ADD CR,NL
  987. KRCHAROK EQU   *
  988.     LA    R0,X'0900'     AH=9
  989.     LA    R1,X'0000'     BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE)
  990.     IC    R1,ATTRIB      BL=ATRIBUTE OF CHAR.
  991.     LA    R14,1          CX=(COUNT OF CHAR TO WRITE)
  992.     IC    R0,KEY         AL=CHAR.
  993.     STC   R0,SCBLINE(R6) STORE CHARACTER IN SCREEN TEXT
  994.     SVC   VIDEO          DISPLAY ASCII CHAR
  995.     L     R14,SCHRSV14
  996.     BR    R14
  997. MVCPAD   MVC   1(0,R2),0(R2)  PAD TO NEW COLUMN
  998. KRCHARCI EQU   *              CHECK INSERT MODE
  999.     CLI   KBINS,INSSTATE
  1000.     BNE   KRCHAROK       NO, GO STORE CHAR AND EXIT
  1001.     CLM   R6,1,=AL1(79)  IS THIS LAST CHAR
  1002.     BE    KRCHAROK       YES, GO STORE CHAR AND EXIT
  1003.     LA    R2,SCBLINE(R6)
  1004.     SR    R1,R1
  1005.     IC    R1,SCBCOL
  1006.     LA    R1,1(R1)
  1007.     STC   R1,SCBCOL      UPDATE ENDING COL
  1008.     SR    R1,R6          R1 = LENGTH OF TEXT + 2 - 1
  1009.     EX    R1,INSMVC1     SAVE TEXT TO BE SHIFTED
  1010.     EX    R1,INSMVC2     MOVE TEXT BACK SHIFTED RIGHT
  1011.     IC    R2,KEY
  1012.     STC   R2,SCBLINE(R6) STORE CHARACTER IN SCREEN TEXT
  1013.     LR    R3,R6
  1014.     BAL   R14,PUTLINE    UPDATE SHIFTED LINE
  1015.     L     R14,SCHRSV14
  1016.     BR    R14
  1017. INSMVC1  MVC   WLBLINE(0),0(R2) MOVE TEXT TO BE SHIFTED RIGHT
  1018. INSMVC2  MVC   1(0,R2),WLBLINE  MOVE TEXT BACK SHIFTED RIGHT 1
  1019. KRESC    EQU   *              PROCESS ESCAPE KEY
  1020.     MVI   EOJ,TRUE
  1021.     BR    R14
  1022. KRPGUP   EQU   *              PROCESS PAGE UP KEY
  1023.     ST    R14,KRSV14
  1024.     L     R12,GLBCUR
  1025.     USING LB,R12
  1026.     LA    R3,12
  1027. KRPGUPL  EQU   *
  1028.     MVC   WLBPREV,LBPREV
  1029.     L     R12,WLBPREV
  1030.     LTR   R12,R12
  1031.     BZ    KRPGUPE
  1032.     ST    R12,GLBCUR
  1033.     SP    PCUR,=P'1'
  1034.     BCT   R3,KRPGUPL
  1035. KRPGUPE  EQU   *
  1036.     BAL   R14,DISPLAY
  1037.     L     R14,KRSV14
  1038.     BR    R14
  1039. KRPGDN   EQU   *              PROCESS PAGE DOWN KEY
  1040.     ST    R14,KRSV14
  1041.     L     R12,GLBCUR
  1042.     LA    R3,12
  1043. KRPGDNL  EQU   *
  1044.     MVC   WLBNEXT,LBNEXT
  1045.     L     R12,WLBNEXT
  1046.     LTR   R12,R12
  1047.     BZ    KRPGDNE
  1048.     ST    R12,GLBCUR
  1049.     AP    PCUR,=P'1'
  1050.     BCT   R3,KRPGDNL
  1051. KRPGDNE  EQU   *
  1052.     BAL   R14,DISPLAY
  1053.     L     R14,KRSV14
  1054.     BR    R14
  1055. KRF1     EQU   *            F1 FOR HELP SCREEN 1
  1056.     ST    R14,KRSV14
  1057.     BAL   R14,CLEAR
  1058.     LA    R2,F1SC
  1059.     L     R3,=A(F1SCEND)
  1060.     BAL   R14,HELPSCRN
  1061.     BAL   R14,GETKEY   WAIT FOR ANY KEY
  1062.     L     R14,KRSV14
  1063.     CLI   KEY,ASCF2
  1064.     BE    KRF2         SWITCH HELP SCREEN WITHOUT DISPLAY
  1065. KRF1COM  EQU   *
  1066.     LA    R15,KRALTF1
  1067.     CLI   KEY,ASCALTF1
  1068.     BE    KRF1WAIT
  1069.     LA    R15,KRALTF2
  1070.     CLI   KEY,ASCALTF2
  1071.     BNE   KRF1SKPW
  1072. KRF1WAIT EQU   *
  1073.     BALR  R14,R15      GO WAIT FOR ALT-F1 OR F2
  1074. KRF1SKPW EQU   *            NOW CLEAR HELP SCREEN
  1075.     BAL   R14,DISPLAY
  1076.     L     R14,KRSV14
  1077.     BR    R14
  1078. HELPSCRN EQU   *            DISPLAY HELP SCREEN
  1079.     LA    R4,0
  1080. HELPLOOP EQU   *
  1081.     ST    R14,HELPSV14
  1082.     SR    R1,R1
  1083.     IC    R1,ATTRIB
  1084.     LR    R15,R4
  1085.     SVC   PRINTTXT
  1086.     LA    R4,ROWINC(R4)
  1087.     CLR   R2,R3
  1088.     BL    HELPLOOP
  1089.     L     R14,HELPSV14
  1090.     BR    R14
  1091. KRF2     EQU   *            F2 FOR HELP SCREEN 2
  1092.     ST    R14,KRSV14
  1093.     BAL   R14,CLEAR
  1094.     L     R2,=A(F2SC)
  1095.     L     R3,=A(F2SCEND)
  1096.     BAL   R14,HELPSCRN
  1097.     BAL   R14,GETKEY   WAIT FOR ANY KEY
  1098.     L     R14,KRSV14
  1099.     CLI   KEY,ASCF1
  1100.     BE    KRF1         SWITCH HELP SCREEN WITHOUT DISPLAY
  1101.     B     KRF1COM
  1102. KRUP     EQU   *            CURSOR UP
  1103.     ST    R14,KRSV14
  1104.     MVI   DIRNEW,DIRUP
  1105.     BAL   R14,KRCHKBOX
  1106.     LTR   R5,R5
  1107.     BNZ   KRUPROW
  1108.     L     R12,SCBPREV
  1109.     LTR   R12,R12
  1110.     BZ    KRUPEXIT
  1111.     ST    R12,GLBCUR
  1112.     SP    PCUR,=P'1'
  1113.     ZAP   PCURLINE,PCUR
  1114.     BAL   R14,CHKMARK
  1115.     BAL   R14,SCRLDOWN
  1116.     L     R12,GLBCUR
  1117.     MVC   SCBLB(LLB),LB    MOVE NEW CURRENT LB TO FIRST LINE
  1118.     ST    R12,SCBADDR
  1119.     ST    R12,GLBCUR
  1120.     SR    R3,R3
  1121.     BAL   R14,PUTLINE
  1122.     MVI   SCBMOD,FALSE
  1123.     B     KRUPEXIT
  1124. KRUPROW  EQU   *
  1125.     BAL   R14,CHKMARK
  1126.     SP    PCURLINE,=P'1'
  1127.     SH    R5,=AL2(ROWINC)
  1128.     SH    R7,=AL2(LSCB)
  1129. KRUPEXIT EQU   *
  1130.     BAL   R14,SETCUR
  1131.     L     R14,KRSV14
  1132.     BR    R14
  1133. KRDOWN   EQU   *            CURSOR DOWN
  1134.     ST    R14,KRSV14
  1135.     MVI   DIRNEW,DIRDOWN
  1136.     BAL   R14,KRCHKBOX
  1137.     CL    R5,LASTROW
  1138.     BL    KRDOWNRW
  1139.     L     R12,SCBNEXT
  1140.     LTR   R12,R12      IS THERE A NEXT LINE
  1141.     BZ    KRDOWNXT     NO, EXIT NOW
  1142.     CL    R5,MAXROW    IS THERE ANOTHER LINE ON SCREEN
  1143.     BL    KRDOWNAR     YES, GO ADD IT
  1144.     ST    R12,WLBNEXT
  1145.     SR    R3,R3
  1146.     LR    R4,R5
  1147.     L     R7,ASCB
  1148.     BAL   R14,SCRLUP   NO, SCROLL SCREEN UP
  1149.     L     R7,ASCB
  1150.     MVC   GLBCUR,SCBADDR  UPDATE SCREEN CURRENCY
  1151.     AP    PCUR,=P'1'
  1152.     L     R7,MAXSCB
  1153.     L     R12,WLBNEXT
  1154. KRDOWNNR EQU   *            UPDATE NEW ROW
  1155.     MVC   SCBLB(LLB),LB
  1156.     ST    R12,SCBADDR
  1157.     SR    R3,R3
  1158.     BAL   R14,PUTLINE
  1159.     MVI   SCBMOD,FALSE
  1160.     AP    PCURLINE,=P'1'
  1161.     B     KRDOWNXT
  1162. KRDOWNAR EQU   *
  1163.     AH    R5,=AL2(ROWINC)
  1164.     AH    R7,=AL2(LSCB)
  1165.     ST    R5,LASTROW
  1166.     ST    R7,LASTSCB
  1167.     B     KRDOWNNR
  1168. KRDOWNRW EQU   *            MOVE CURSOR DOWN ROW
  1169.     AP    PCURLINE,=P'1'
  1170.     AH    R5,=AL2(ROWINC)
  1171.     AH    R7,=AL2(LSCB)
  1172. KRDOWNXT EQU   *
  1173.     BAL   R14,SETCUR
  1174.     BAL   R14,CHKMARK
  1175.     L     R14,KRSV14
  1176.     BR    R14
  1177. KRLEFT   EQU   *            CURSOR LEFT
  1178.     ST    R14,KRSV14
  1179.     MVI   DIRNEW,DIRLEFT
  1180.     BAL   R14,KRCHKBOX
  1181.     BCTR  R6,0
  1182.     SP    PCOL,=P'1'
  1183.     BNZ   KRLEFT1
  1184.     LA    R6,79
  1185.     ZAP   PCOL,=P'80'
  1186. KRLEFT1  EQU   *
  1187.     BAL   R14,SETCUR
  1188.     L     R14,KRSV14
  1189.     BR    R14
  1190. KRRIGHT  EQU   *            CURSOR RIGHT
  1191.     ST    R14,KRSV14
  1192.     MVI   DIRNEW,DIRRIGHT
  1193.     BAL   R14,KRCHKBOX
  1194.     AP    PCOL,=P'1'
  1195.     LA    R6,1(R6)
  1196.     CH    R6,=AL2(79)
  1197.     BNH   KRRIGHT1
  1198.     ZAP   PCOL,=P'1'
  1199.     LA    R6,0
  1200. KRRIGHT1 EQU   *
  1201.     BAL   R14,SETCUR
  1202.     L     R14,KRSV14
  1203.     BR    R14
  1204. KRCHKBOX EQU   *             SET BOX CHAR AT CURSOR IF BOX MODE
  1205.     SR    R1,R1
  1206.     IC    R1,DIRLAST
  1207.     MVC   DIRLAST,DIRNEW
  1208.     CLI   BOX,TRUE
  1209.     BNER  R14
  1210.     ST    R14,KRBXSV14
  1211.     IC    R0,REVDIR(R1)
  1212.     STC   R0,REVLAST    SAVE REVERSE OF LAST DIRECTION
  1213.     SLL   R1,2
  1214.     LA    R2,DIRTAB(R1) SELECT TABLE ROW BASED ON 4*DIRLAST
  1215.     IC    R1,DIRNEW
  1216.     IC    R1,0(R1,R2)   R1 = DIRECTION KEY INDEX
  1217.     L     R2,BOXSETA
  1218.     IC    R1,0(R1,R2)   R1 = KEY FROM INDEXED SET
  1219.     STC   R1,KEY        SELECT KEY FROM BOXSET(NEWDIR,OLDDIR)
  1220.     CLI   CONNECT,TRUE
  1221.     BNE   KRCHKBOK      KEY OK IF NOT IN CONNECT MODE
  1222.     CLM   R6,1,SCBCOL
  1223.     BNL   KRCHKBOK      KEY OK IF NO PREVIOUS CHARACTER AT CURSOR
  1224.     SR    R0,R0
  1225.     IC    R0,SCBLINE(R6)
  1226.     SH    R0,=AL2(179)  R0 = GRAPHIC CHAR. INDEX
  1227.     BM    KRCHKBOK      KEY OK IF CHAR AT CURSOR < FIRST GRAPHIC
  1228.     CLM   R0,1,=AL1(218-179)
  1229.     BH    KRCHKBOK      KEY OK IF CHAR AT CURSOR > LAST GRAPHIC
  1230.     CL    R2,=A(BOXSET1) IS CURRENT BOX SET SINGLE LINE
  1231.     BNE   KRCHKBS2
  1232.     LA    R2,BOXCON     R2 = BOXCON( SINGLE BOX SET)
  1233.     B     KRCHKBCN
  1234. KRCHKBS2 EQU   *
  1235.     CL    R2,=A(BOXSET2) IS CURRENT BOX SET DOUBLE LINE
  1236.     BNE   KRCHKBOK      NO, KEY OK AS IS
  1237.     LA    R2,BOXCON+4   R2 = BOXCON( DOUBLE BOX SET)
  1238. KRCHKBCN EQU   *             USE BOX CONNECT TABLE TO CONNECT NEW DIR
  1239.     SLL   R0,3
  1240.     LR    R1,R2
  1241.     AR    R1,R0         R1 = A(BOXCON(S/D SET, OLD CHAR))
  1242.     SR    R0,R0
  1243.     IC    R0,DIRNEW
  1244.     AR    R1,R0         R1 = A(BOXCON(S/D SET, OLD CHAR, NEWDIR))
  1245.     IC    R0,0(R1)
  1246.     SH    R0,=AL2(179)  CONVERT NEW KEY TO INDEX
  1247.     SLL   R0,3          REPEAT PROCESS TO CONNECT OLD DIR LINE
  1248.     LR    R1,R2
  1249.     AR    R1,R0
  1250.     SR    R0,R0
  1251.     IC    R0,REVLAST    USE REVERSE OF OLD DIR TO SHARE BOXCON
  1252.     AR    R1,R0
  1253.     IC    R0,0(R1)
  1254.     STC   R0,KEY        SET NEW GRAPHIC CHAR WITH CONNECTIONS
  1255. KRCHKBOK EQU   *
  1256.     BAL   R14,KRSETCHR  STORE KEY AT CURSOR
  1257. KRCHKBX1 EQU   *
  1258.     LA    R0,X'0100'
  1259.     SVC   KEYBOARD
  1260.     STCM  R0,4,PWORK
  1261.     TM    PWORK,X'40'   IS THERE ANOTHER KEY WAITING
  1262.     BNZ   KRCHKBX2      NO, PROCEED
  1263.     LA    R0,X'0000'
  1264.     SVC   KEYBOARD      YES, FLUSH KEY AND TRY AGAIN
  1265.     B     KRCHKBX1
  1266. KRCHKBX2 EQU   *
  1267.     L     R14,KRBXSV14
  1268.     BR    R14
  1269. KRINS    EQU   *            INSERT KEY TOGGLED - UPDATE STATUS LINE
  1270.     ST    R14,KRSV14
  1271.     XI    KBINS,INSSTATE  TOGGLE INS (IGNORE INS STATUS LINE)
  1272.     BAL   R14,KEYSTATS
  1273.     L     R14,KRSV14
  1274.     BR    R14
  1275. KRDEL    EQU   *            DELETE CHAR OR BLOCK VIA DEL KEY
  1276.     ST    R14,KRSV14
  1277.     CLI   BLKLABEL,FALSE   IS THERE A LABELED BLOCK
  1278.     BNE   KRDELBLK         YES, GO DELETE IT
  1279. KRDELCHR EQU   *
  1280.     CLM   R6,1,SCBCOL  IS CURSOR PAST END OF LINE
  1281.     BNLR  R14          YES, IGNORE DELETE KEY
  1282.     MVI   SCBMOD,TRUE  LINE MOD
  1283.     MVI   SCRMOD,TRUE  SCREEN MOD
  1284.     SR    R1,R1
  1285.     IC    R1,SCBCOL
  1286.     BCTR  R1,0
  1287.     STC   R1,SCBCOL    UPDATE ENDING COL
  1288.     LR    R4,R1        SAVE COL TO BLANK ON SCREEN
  1289.     LA    R1,2(R1)
  1290.     SR    R1,R6
  1291.     LA    R2,SCBLINE(R6)
  1292.     EX    R1,MVCLEFT   SHIFT TEXT ONLY TO OVERLAY DEL CHAR
  1293.     LA    R0,X'0200'   AH=2 SET CURSOR
  1294.     LA    R1,0         BH=0 PAGE
  1295.     LA    R15,0(R5,R4) DH=ROW,DL=COL  OLD LAST CHAR
  1296.     SVC   VIDEO        UPDATE CURSOR
  1297.     LA    R0,X'0920'  AH=9, AL= ASCII BLANK
  1298.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  1299.     IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.
  1300.     LA    R14,1       CX=(COUNT OF CHAR TO WRITE)
  1301.     SVC   VIDEO       DISPLAY CHAR
  1302.     LR    R3,R6
  1303.     BAL   R14,PUTLINE  REFRESH LINE TO NEW END OF LINE
  1304.     BAL   R14,SETCUR
  1305.     L     R14,KRSV14
  1306.     BR    R14
  1307. MVCLEFT  MVC   0(0,R2),1(R2)
  1308. KRCTLKY  EQU   *            DELETE LABELED BLOCK VIA CTL-K Y
  1309.     ST    R14,KRSV14
  1310.     CLI   BLKLABEL,FALSE
  1311.     BER   R14
  1312. KRDELBLK EQU   *            DELETE LABELED BLOCK
  1313.     LA    R1,=CL20'DELETE BLOCK'
  1314.     BAL   R14,PUTMSG
  1315.     MVI   CURDEL,FALSE RESET CURRENT LB DELETE SWITCH
  1316.     ZAP   PBLKCNT,=P'0'
  1317.     L     R12,BLK1LB
  1318. KRDELBK1 EQU   *            CHECK IF CURRENT LB IN BLOCK
  1319.     AP    PBLKCNT,=P'1'
  1320.     CL    R12,GLBCUR   IS CURRENT LINE BEING DELETED
  1321.     BNE   KRDELBKC
  1322.     MVI   CURDEL,TRUE  YES, SET SWITCH
  1323. KRDELBKC EQU   *
  1324.     CL    R12,BLK2LB
  1325.     BE    KRDELBK2    OK, GO DELETE BLOCK
  1326.     MVC   WLBNEXT,LBNEXT  GET NEXT LB TO DUP.
  1327.     L     R12,WLBNEXT
  1328.     LTR   R12,R12
  1329.     BNZ   KRDELBK1
  1330.     LA    R1,=CL20'BLOCK NOT FOUND'
  1331.     BAL   R14,PUTMSG
  1332.     B     KRDEXIT
  1333. KRDELBK2 EQU   *            OK TO DELETE BLOCK
  1334.     MVI   SCRMOD,TRUE     SET SCREEN MOD
  1335.     L     R12,BLK1LB
  1336.     MVC   WLBPREV,LBPREV  GET PREV. FROM FIRST BLOCK
  1337.     L     R12,BLK2LB
  1338.     BAL   R14,CHKADDR
  1339.     MVC   WLBNEXT,LBNEXT  GET NEXT  FROM LAST  BLOCK
  1340.     MVC   LBNEXT,AFREELB  CHAIN FREE QUEUE TO LAST
  1341.     MVC   AFREELB,BLK1LB            SET   FREE QUEUE TO FIRST
  1342.     L     R12,WLBPREV
  1343.     LTR   R12,R12
  1344.     BZ    KRDELFST                  GO SET NEW FIRST LB
  1345.     BAL   R14,CHKADDR
  1346.     MVC   LBNEXT,WLBNEXT  CHAIN PREV TO NEXT
  1347.     B     KRDELCKL
  1348. KRDELFST EQU   *
  1349.     MVC   GLBFIRST,WLBNEXT         RESET FIRST PAST BLOCK
  1350. KRDELCKL EQU   *
  1351.     L     R12,WLBNEXT
  1352.     LTR   R12,R12
  1353.     BZ    KRDELLST
  1354.     SP    PLSTLINE,PBLKCNT
  1355.     BAL   R14,CHKADDR
  1356.     MVC   LBPREV,WLBPREV CHAIN NEXT TO PREV
  1357.     B     KRDELCUR
  1358. KRDELLST EQU   *
  1359.     MVC   GLBLAST,WLBPREV          RESET LAST TO PREV
  1360.     ZAP   PLSTLINE,PCURBLK1
  1361.     SP    PLSTLINE,=P'1'
  1362. KRDELCUR EQU   *
  1363.     CLI   CURDEL,TRUE              IS CURRENT LB DELETED
  1364.     BNE   KRDEXIT                  NO, EXIT WITH DISPLAY REQ.
  1365.     ZAP   PCUR,PCURBLK1
  1366.     SP    PCUR,=P'1'
  1367.     MVC   GLBCUR,WLBPREV           YES, TRY PREV
  1368.     CLC   GLBCUR,=A(0)             IS PREV ZERO
  1369.     BNE   KRDEXIT                  NO, EXIT
  1370.     ZAP   PCUR,=P'1'
  1371.     MVC   GLBCUR,WLBNEXT           YES, TRY NEXT
  1372. KRDEXIT  EQU   *
  1373.     MVI   BLKLABEL,FALSE           RESET LABEL
  1374.     MVC   STATBLK,=C'   '
  1375.     LA    R3,STATBLK
  1376.     LA    R4,L'STATBLK
  1377.     BAL   R14,PUTSTAT
  1378.     BAL   R14,AUDITMS
  1379.     BAL   R14,PUTPCT
  1380.     BAL   R14,DISPLAY
  1381.     L     R14,KRSV14
  1382.     BR    R14
  1383. KRCR     EQU   *            CARRIAGE RETURN (ENTER)
  1384.     ST    R14,KRCRSV14
  1385.     CLI   KBINS,INSSTATE     INSERT MODE
  1386.     BE    KRINSLN      YES GO INSERT LINE
  1387.     BAL   R14,KRDOWN   NO, MOVE DOWN LINE
  1388.     B     KRINSEXT     EXIT
  1389. KRINSLN  EQU   *            INSERT LINE
  1390.     L     R12,SCBADDR
  1391.     BAL   R14,GETNEWLB GET FREE LB IN EXT. MEMORY
  1392.     L     R14,KRCRSV14
  1393.     LTR   R15,R15
  1394.     BNZR  R14          IGNORE REQUEST IF NO ROOM
  1395.     AP    PLSTLINE,=P'1'
  1396.     MVI   FILEMOD,TRUE SET FILE CHANGE
  1397.     MVI   SCRMOD,TRUE  SET SCREEN MODE
  1398.     LTR   R6,R6
  1399.     BNZ   KRINSAFT     IF NOT COL 0, INSERT AFTER CURRENT LINE
  1400.     L     R12,SCBPREV
  1401.     LTR   R12,R12
  1402.     BNZ   KRINSPRE     IF NOT FIRST, INSERT AFTER PREV. LINE
  1403. KRINSFST EQU   *            ELSE MAKE NEW LINE FIRST LINE
  1404.     MVC   GLBFIRST,ANEWLB  RESET FIRST LB POINTER
  1405.     MVC   GLBCUR,ANEWLB    RESET CURRENT LB POINTER
  1406.     MVC   WLBPREV,=A(0)    SET NO PREV.
  1407.     MVC   WLBNEXT,SCBADDR  CHAIN OLD CURRENT TO NEW
  1408.     BAL   R14,SCRLDOWN  SCROLL DOWN AND ADJUST SCB'S
  1409.     BAL   R14,KRINSWLB  CREATE NULL LB AND UPDATE SCB'S
  1410.     B     KRINSEXT
  1411. KRINSPRE EQU   *
  1412.     LTR   R5,R5        IS THIS FIRST LINE
  1413.     BNZ   KRINSSKC     NO, LEAVE CURRENT LINE ON SCREEN
  1414.     SP    PCUR,=P'1'
  1415.     SP    PCURLINE,=P'1'
  1416.     MVC   GLBCUR,SCBPREV  YES, MOVE PREV. LINE TO TOP LINE
  1417.     MVC   WLBPREV,SCBPREV CHAIN NEW LINE TO PREV. LB
  1418.     MVC   WLBNEXT,SCBADDR
  1419.     BAL   R14,SCRLDOWN MOVE FIRST TWO LINES DOWN
  1420.     BAL   R14,SCRLDOWN
  1421.     L     R12,GLBCUR
  1422.     MVC   SCBLB(LLB),LB
  1423.     ST    R12,SCBADDR
  1424.     SR    R3,R3
  1425.     BAL   R14,PUTLINE
  1426.     MVI   SCBMOD,FALSE
  1427.     LA    R5,ROWINC(R5) RESET CURSOR TO SECOND LINE
  1428.     LA    R7,LSCB(R7)
  1429.     BAL   R14,KRINSWLB  INSERT NEW LB AND UPDATE SCB
  1430.     B     KRINSEXT
  1431. KRINSSKC EQU   *            LINK BETWEEN PREV AND CURRENT
  1432.     MVC   WLBPREV,SCBPREV
  1433.     MVC   WLBNEXT,SCBADDR
  1434.     BAL   R14,SCRLDOWN SCROLL DOWN
  1435.     BAL   R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
  1436.     B     KRINSEXT
  1437. KRINSAFT EQU   *            LINK BETWEEN CURRENT AND NEXT
  1438.     CLC   SCBNEXT,=A(0)  IS NEW LINE AT END
  1439.     BNE   KRINSANL       NO, SKIP UPDATE TO LAST
  1440.     MVC   GLBLAST,ANEWLB
  1441. KRINSANL EQU   *
  1442.     MVC   WLBPREV,SCBADDR
  1443.     MVC   WLBNEXT,SCBNEXT
  1444.     CL    R5,MAXROW
  1445.     BL    KRINSASD     IF NOT LAST ROW, SCROLL DOWN
  1446. KRINSASU EQU   *            SCROLL UP FOR NEW LINE ON LAST ROW
  1447.     LA    R3,0
  1448.     LR    R4,R5
  1449.     ST    R7,SAVESCB
  1450.     L     R7,ASCB
  1451.     BAL   R14,SCRLUP   IF LAST LINE, SCROLL UP
  1452.     L     R7,SAVESCB
  1453.     AP    PCURLINE,=P'1'
  1454.     BAL   R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
  1455.     B     KRINSEXT
  1456. KRINSASD EQU   *             SCROLL DOWN AND INSERT NEW ROW
  1457.     LA    R5,ROWINC(R5) MOVE TO NEXT ROW
  1458.     AP    PCURLINE,=P'1'
  1459.     LA    R7,LSCB(R7)
  1460.     BAL   R14,SCRLDOWN
  1461.     BAL   R14,KRINSWLB
  1462. KRINSEXT EQU   *
  1463.     LA    R6,0
  1464.     ZAP   PCOL,=P'1'
  1465.     CLI   HTMODE,TRUE
  1466.     BNE   KRSKPHT
  1467.     BAL   R14,KRHT     TAB
  1468. KRSKPHT  EQU   *
  1469.     BAL   R14,PUTPCT
  1470.     BAL   R14,SETCUR     RESET CURSOR ON NEW INSERTED LINE
  1471.     CLI   KBINS,INSSTATE IS INSERT ON
  1472.     BNE   KRSKPDN        NO, SKIP EXTRA DOWN
  1473.     CLC   LASTKEY,KEY    WAS LAST KEY ALSO CR TO INSERT
  1474.     BNE   KRSKPDN        YES, MOVE CURSOR DOWN TO PREV INSERT
  1475.     BAL   R14,KRDOWN
  1476. KRSKPDN  EQU   *
  1477.     BAL   R14,AUDITMS
  1478.     L     R14,KRCRSV14
  1479.     BR    R14
  1480.     TITLE 'KRINSWLB - CREATE NULL WLB AND UPDATE LB'S AND SCB'
  1481. KRINSWLB EQU   *
  1482.     ST    R14,INSCSV14
  1483.     MVC   WLBLINE,=AL1(ASCCR,ASCLF) SET TEXT TO NULL LINE
  1484.     MVC   SCBADDR,ANEWLB
  1485.     MVC   SCBLB,WLB     MOVE NEW LB INTO CURRENT SCB
  1486.     MVI   SCBCOL,0
  1487.     MVI   SCBMOD,FALSE
  1488.     L     R12,ANEWLB
  1489.     BAL   R14,CHKADDR
  1490.     MVC   LB(LLB),WLB         INIT NEW LB
  1491. KRINSWLN EQU   *
  1492.     L     R12,WLBNEXT
  1493.     LTR   R12,R12
  1494.     BZ    KRINSWLP
  1495.     BAL   R14,CHKADDR
  1496.     MVC   LBPREV,ANEWLB  CHAIN NEXT LB BACK TO NEW LB
  1497.     LA    R1,LSCB(R7)
  1498.     CL    R1,MAXSCB                 IS THERE A NEXT SCB
  1499.     BH    KRINSWLP
  1500.     MVC   SCBPREV-SCB(4,R1),ANEWLB  ALSO UPDATE NEXT SCB
  1501. KRINSWLP EQU   *
  1502.     L     R12,WLBPREV
  1503.     LTR   R12,R12
  1504.     BZ    KRINSWLE
  1505.     BAL   R14,CHKADDR
  1506.     MVC   LBNEXT,ANEWLB  CHAIN PREV LB TO NEW LB
  1507.     LR    R1,R7
  1508.     SH    R1,=AL2(LSCB)
  1509.     CL    R1,ASCB                  IS THERE A PREV SCB
  1510.     BL    KRINSWLE
  1511.     MVC   SCBNEXT-SCB(4,R1),ANEWLB ALSO UPDATE PREV SCB
  1512. KRINSWLE EQU   *
  1513.     L     R14,INSCSV14
  1514.     BR    R14
  1515.     TITLE 'SCRLDOWN - SCROLL SCREEN DOWN 1 LINE'
  1516. *
  1517. * SCROLL SCREEN DOWN FROM CURRENT ROW TO MAXROW
  1518. *
  1519. SCRLDOWN EQU   *
  1520.     ST    R14,SCRLSV14
  1521.     CL    R5,MAXROW   IS CURRENT ROW = LAST ROW
  1522.     BE    SCRLDWN1    YES, GO CLEAR LINE
  1523.     LA    R0,X'0701'  SCROLL DOWN 1 LINE
  1524.     LR    R14,R5      CX = STARTING ROW,COL
  1525.     L     R15,=A(SCRLEND) DX = ENDING   ROW,COL
  1526.     LA    R1,0
  1527.     ICM   R1,B'0010',ATTRIB
  1528.     SVC   VIDEO
  1529.     L     R1,MAXSCB
  1530.     B     SCRLDWNS
  1531. SCRLDWN1 EQU   *
  1532.     LR    R3,R5
  1533.     BAL   R14,CLRLINE
  1534. SCRLDWNS EQU   *
  1535.     CLC   LASTROW,MAXROW       IS LAST ROW ACTIVE
  1536.     BL    SCRLSKPU             NO, IGNORE
  1537.     CLI   SCBMOD-SCB(R1),TRUE  HAS IT CHANGED
  1538.     BNE   SCRLSKPU             NO, THROW AWAY
  1539.     L     R12,SCBADDR-SCB(R1)  YES, UPDATE MEMORY
  1540.     BAL   R14,CHKADDR
  1541.     MVC   LB(LLB),SCBLB-SCB(R1)  SAVE UPDATED LAST LINE
  1542. SCRLSKPU EQU   *
  1543.     L     R2,=A(22*ROWINC)   ROW BEING MOVED DOWN
  1544.     SH    R1,=AL2(LSCB)
  1545. SCRLSHFT EQU   *
  1546.     CR    R2,R5
  1547.     BL    SCRLUPLT
  1548.     MVC   LSCB(LSCB,R1),0(R1) MOVE SCB DOWN ONE
  1549.     SH    R1,=AL2(LSCB)
  1550.     SH    R2,=AL2(ROWINC)
  1551.     B     SCRLSHFT
  1552. SCRLUPLT EQU   *           UPDATE LAST ROW
  1553.     L     R1,LASTROW
  1554.     LA    R1,ROWINC(R1)
  1555.     CL    R1,MAXROW
  1556.     BH    SCRLEXIT
  1557.     ST    R1,LASTROW
  1558.     L     R1,LASTSCB
  1559.     LA    R1,LSCB(R1)
  1560.     ST    R1,LASTSCB
  1561. SCRLEXIT EQU   *
  1562.     L     R14,SCRLSV14
  1563.     BR    R14
  1564.     TITLE 'SCRLUP - SCROLL SCREEN UP 1 LINE'
  1565. *
  1566. *  R3 - STARTING ROW
  1567. *  R4 - ENDING ROW
  1568. *  R7 - STARTING SCB
  1569. *
  1570. SCRLUP   EQU   *
  1571.     ST    R14,SCRLSV14
  1572.     CLR   R3,R4       DON'T SCROLL 1 LINE
  1573.     BE    SCRLUP1
  1574.     LA    R0,X'0601'  SCROLL DOWN 1 LINE
  1575.     LA    R14,0(R3)   CX = STARTING ROW,COL
  1576.     LA    R15,79(R4)  DX = ENDING   ROW,COL
  1577.     LA    R1,0
  1578.     ICM   R1,B'0010',ATTRIB
  1579.     SVC   VIDEO
  1580.     B     SCRLUPSS
  1581. SCRLUP1  EQU   *
  1582.     BAL   R14,CLRLINE CLEAR ROW R3 ON SCREEN
  1583. SCRLUPSS EQU   *
  1584.     CLI   SCBMOD,TRUE  HAS IT CHANGED
  1585.     BNE   SCRLUPSK     NO, THROW AWAY
  1586.     L     R12,SCBADDR  YES, UPDATE MEMORY
  1587.     BAL   R14,CHKADDR
  1588.     MVC   LB(LLB),SCBLB  SAVE UPDATED FIRST LINE
  1589. SCRLUPSK EQU   *
  1590.     LA    R2,ROWINC(R3)  ROW BEING MOVED UP
  1591. SCRLUPSH EQU   *
  1592.     CR    R2,R4
  1593.     BH    SCRLUPEX
  1594.     MVC   0(LSCB,R7),LSCB(R7) MOVE SCB UP ONE
  1595.     LA    R7,LSCB(R7)
  1596.     LA    R2,ROWINC(R2)
  1597.     B     SCRLUPSH
  1598. SCRLUPEX EQU   *
  1599.     L     R14,SCRLSV14
  1600.     BR    R14
  1601.     TITLE 'CLRLINE - CLEAR ROW R3 ON SCREEN'
  1602. CLRLINE  EQU   *
  1603.     ST    R14,CLRLSV14
  1604.     LA    R0,X'0200'  AH=2 SET CURSOR
  1605.     LA    R1,0        BH=0 PAGE
  1606.     LR    R15,R3      DH=ROW,DL=COL
  1607.     SVC   VIDEO       SET CURSOR TO UPPER LEFT CORNER
  1608.     LA    R0,X'0920'  AH=10, AL=SPACE
  1609.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  1610.     IC    R1,ATTRIB
  1611.     LA    R14,80      CHARACTERS ON DATA LINES
  1612.     SVC   VIDEO       CLEAR DATA LINES
  1613.     L     R14,CLRLSV14
  1614.     BR    R14
  1615. KRHOME   EQU   *            HOME
  1616.     ST    R14,KRSV14
  1617.     MVC   GLBCUR,GLBFIRST
  1618.     ZAP   PCUR,=P'1'
  1619.     BAL   R14,DISPLAY
  1620.     L     R14,KRSV14
  1621.     BR    R14
  1622. KREND    EQU   *            END
  1623.     MVC   GLBCUR,GLBLAST
  1624.     ZAP   PCUR,PLSTLINE
  1625.     B     KRPGUP
  1626. KRSHF6   EQU   *            SHIFT F6 (DELETE LINE)
  1627.     ST    R14,KRSV14
  1628.     SP    PLSTLINE,=P'1'
  1629.     MVI   FILEMOD,TRUE
  1630.     L     R12,SCBADDR        ERR 8
  1631.     MVC   WLB(8),LB
  1632.     LA    R0,12              *************************
  1633.     LA    R1,WLB               VALIDATE SCB/LB MATCH
  1634.     LA    R2,SCBLB           *************************
  1635.     CLC   WLB(8),SCBLB
  1636.     BNE   AUDITBUG           SCB PREV/NEXT NE LB PREV/NEXT
  1637.     BAL   R14,CHKADDR
  1638.     MVC   LBNEXT,AFREELB    CHAIN FREE QUEUE TO LB
  1639.     ST    R12,AFREELB                 POINT TO DELETED LB
  1640.     L     R12,WLBPREV
  1641.     LTR   R12,R12
  1642.     BZ    KRSHF6F     GO UPDATE FIRST LB POINTER
  1643.     BAL   R14,CHKADDR
  1644.     MVC   LBNEXT,WLBNEXT    SET NEXT IN PREV. LB
  1645.     LTR   R5,R5
  1646.     BZ    KRSHF6N     GO UDATE PREV POINTER
  1647.     LR    R1,R7
  1648.     SH    R1,=AL2(LSCB)
  1649.     MVC   SCBNEXT-SCB(4,R1),WLBNEXT
  1650.     B     KRSHF6N
  1651. KRSHF6F  EQU   *
  1652.     MVC   GLBFIRST,WLBNEXT  UPDATE FIRST LB POINTER
  1653. KRSHF6N  EQU   *
  1654.     L     R12,WLBNEXT
  1655.     LTR   R12,R12
  1656.     BZ    KRSHF6L     IF LAST GO UPDATE LAST LB POINTER
  1657.     BAL   R14,CHKADDR
  1658.     MVC   LBPREV,WLBPREV   SET PREV IN NEXT LB
  1659.     CL    R5,MAXROW
  1660.     BNL   KRSHF6E
  1661.     LA    R1,LSCB(R7)
  1662.     MVC   SCBPREV-SCB(4,R1),WLBPREV
  1663.     B     KRSHF6E
  1664. KRSHF6L  EQU   *
  1665.     MVC   GLBLAST,WLBPREV   UPDATE LAST LB POINTER
  1666. KRSHF6E  EQU   *
  1667.     CLC   GLBCUR,SCBADDR  IS CURRENT LINE BEING DELETED
  1668.     BNE   KRSHF6EX        NO, EXIT
  1669.     MVC   GLBCUR,WLBNEXT  YES, TRY NEXT
  1670.     CLC   GLBCUR,=A(0)    IS NEXT NULL
  1671.     BNE   KRSHF6EX        NO, EXIT
  1672.     SP    PCUR,=P'1'
  1673.     MVC   GLBCUR,WLBPREV  YES, TRY PREV.
  1674.     CLC   GLBCUR,=A(0)    IS FILE NOW EMPTY
  1675.     BNE   KRSHF6ND        NO, GO DISPLAY PREV. LINE
  1676.     BAL   R14,NEWFILE     YES, CREATE NULL FILE
  1677. KRSHF6ND EQU   *
  1678.     BAL   R14,DISPLAY
  1679.     B     KRSHF6SC
  1680. KRSHF6EX EQU   *
  1681.     ST    R5,SAVEROW
  1682.     ST    R7,SAVESCB
  1683.     LR    R3,R5
  1684.     L     R4,MAXROW
  1685.     BAL   R14,SCRLUP      SCROLL SCREEN UP OVERLAYING DEL LINE
  1686.     LA    R6,0            RESET COLUMN
  1687.     ZAP   PCOL,=P'1'
  1688.     CLC   LASTSCB,MAXSCB  WAS LAST ROW ACTIVE
  1689.     BL    KRSHF6NL        NO, GO REDUCE LAST ROW POINTER
  1690.     L     R7,MAXSCB
  1691.     L     R12,SCBNEXT
  1692.     LTR   R12,R12         IS THERE NEW LINE FOR LAST ROW
  1693.     BZ    KRSHF6NL        NO, GO DECREMENT LAST ROW
  1694.     MVC   SCBLB(LLB),LB  MOVE IN NEW LAST LINE
  1695.     ST    R12,SCBADDR
  1696.     MVI   SCBMOD,FALSE
  1697.     SR    R3,R3
  1698.     L     R5,MAXROW
  1699.     BAL   R14,PUTLINE        DISPLAY NEW LAST LINE
  1700.     B     KRSHF6XT
  1701. KRSHF6NL EQU   *               UPDATE NEW LAST ROW
  1702.     L     R5,LASTROW
  1703.     L     R7,LASTSCB
  1704.     SH    R5,=AL2(ROWINC)
  1705.     SH    R7,=AL2(LSCB)
  1706.     ST    R5,LASTROW
  1707.     ST    R7,LASTSCB
  1708. KRSHF6XT EQU   *
  1709.     L     R5,SAVEROW
  1710.     L     R7,SAVESCB
  1711.     CL    R5,LASTROW
  1712.     BNH   KRSHF6SC
  1713.     SP    PCURLINE,=P'1'
  1714.     L     R5,LASTROW
  1715.     L     R7,LASTSCB
  1716. KRSHF6SC EQU   *
  1717.     BAL   R14,AUDITMS
  1718.     BAL   R14,PUTPCT
  1719.     BAL   R14,SETCUR
  1720.     L     R14,KRSV14
  1721.     BR    R14
  1722. KRF3     EQU   *            F3 (START OF LINE)
  1723.     ST    R14,KRSV14
  1724.     LA    R6,0
  1725.     ZAP   PCOL,=P'1'
  1726.     BAL   R14,SETCUR
  1727.     L     R14,KRSV14
  1728.     BR    R14
  1729. KRF4     EQU   *            F4 (END OF LINE)
  1730.     ST    R14,KRSV14
  1731.     IC    R6,SCBCOL
  1732.     CH    R6,=AL2(79)
  1733.     BNH   KRF4SKPL
  1734.     BCTR  R6,0
  1735. KRF4SKPL EQU   *
  1736.     CVD   R6,PWORK
  1737.     ZAP   PCOL,PWORK
  1738.     AP    PCOL,=P'1'
  1739.     BAL   R14,SETCUR
  1740.     L     R14,KRSV14
  1741.     BR    R14
  1742. KRF5     EQU   *            F5 (LABEL BLOCK)
  1743.     ST    R14,KRSV14
  1744.     CLI   BLKLABEL,FALSE
  1745.     BE    KRF5MARK       IF FALSE, SET MARK
  1746.     CLI   BLKLABEL,MARK  IF MARK,  SET TRUE
  1747.     BE    KRF5TRUE
  1748.     MVI   BLKLABEL,FALSE ELSE, TURN BLOCK LABEL BACK OFF
  1749.     MVC   STATBLK,=C'   '
  1750.     LA    R3,STATBLK
  1751.     LA    R4,L'STATBLK
  1752.     BAL   R14,PUTSTAT
  1753.     BAL   R14,DISPLAY    REMOVE MARKED LINES FROM SCREEN
  1754. KRF5EXIT EQU   *
  1755.     L     R14,KRSV14
  1756.     BR    R14
  1757. KRF5MARK EQU   *
  1758.     LA    R1,=CL20'MARKING BLOCK'
  1759.     BAL   R14,PUTMSG
  1760.     MVI   BOX,FALSE       TURN OFF BOX GRAPHICS
  1761.     MVI   BLKLABEL,MARK
  1762.     MVC   STATBLK,=C'BLK'
  1763.     LA    R3,STATBLK
  1764.     LA    R4,L'STATBLK
  1765.     BAL   R14,PUTSTAT
  1766.     BAL   R14,CHKMARK
  1767.     MVC   BLK1LB,SCBADDR
  1768.     ZAP   PCURBLK1,PCURLINE
  1769.     B     KRF5EXIT
  1770. KRF5TRUE EQU   *
  1771.     LA    R1,=CL20'POSITIONING BLOCK'
  1772.     BAL   R14,PUTMSG
  1773.     MVI   BLKLABEL,TRUE
  1774.     MVC   BLK2LB,SCBADDR
  1775.     B     KRF5EXIT
  1776. KRF6     EQU   *            F6 (DUPLICATE BLOCK)
  1777.     ST    R14,KRSV14
  1778.     CLI   BLKLABEL,TRUE
  1779.     BNE   KRF6NOTD     NO DUP IF NO BLOCK DEFINED CURRENTLY
  1780.     MVC   PREVDUP,SCBPREV
  1781.     L     R12,BLK1LB
  1782. KRF6L1   EQU   *            CHECK IF CHAINED LB IN BLOCK
  1783.     CL    R12,BLK2LB
  1784.     BE    KRF6OK       OK, GO DUPLICATE
  1785.     CL    R12,PREVDUP
  1786.     BE    KRF6NOTD     NO DUP IF INSIDE BLOCK
  1787.     MVC   WLBNEXT,LBNEXT GET NEXT LB TO DUP.
  1788.     L     R12,WLBNEXT
  1789.     LTR   R12,R12
  1790.     BNZ   KRF6L1
  1791. KRF6NOTD EQU   *            NO DUP DUE TO NO BLK OR INSIDE BLK
  1792.     LA    R1,=CL20'NO DUP - INV. REQ.'
  1793.     BAL   R14,PUTMSG
  1794.     L     R14,KRSV14
  1795.     BR    R14
  1796. KRF6OK   EQU   *            OK TO DUPLICATE
  1797.     LA    R1,=CL20'DUPLICATING BLOCK'
  1798.     BAL   R14,PUTMSG
  1799.     MVC   STATBLK,=C'   '
  1800.     LA    R3,STATBLK
  1801.     LA    R4,L'STATBLK
  1802.     BAL   R14,PUTSTAT
  1803.     MVI   BLKLABEL,FALSE    TURN OFF BLOCK
  1804.     MVI   FILEMOD,TRUE      SET FILE CHANGE
  1805.     BAL   R14,UPDATE        UPDATE MS FROM SCREEN BEFORE COPY
  1806.     MVC   SAVENEXT,SCBADDR  SAVE NEXT TO STORE IN LAST
  1807.     MVC   NEXTBLK,BLK1LB
  1808. KRF6DUP  EQU   *
  1809.     BAL   R14,GETNEWLB
  1810.     LTR   R15,R15
  1811.     BNZ   KRF6LAST     IF NO MORE LB'S, GO FINISH LAST LB
  1812.     AP    PLSTLINE,=P'1'
  1813.     LTR   R5,R5
  1814.     BNZ   KRF6SKPC       IF INSERTING BEFORE FIRST LINE,
  1815.     AP    PCUR,=P'1'     INCR CURRENT LINE COUNTERS
  1816.     AP    PCURLINE,=P'1'
  1817. KRF6SKPC EQU   *
  1818.     L     R12,NEXTBLK
  1819.     MVC   WLB(LLB),LB   GET FIRST LB TO DUP
  1820.     MVC   WLBPREV,PREVDUP
  1821.     L     R12,ANEWLB
  1822.     BAL   R14,CHKADDR
  1823.     MVC   LB(LLB),WLB   COPY TO NEW LB
  1824.     L     R12,WLBPREV
  1825.     LTR   R12,R12
  1826.     BNZ   KRF6DUPP
  1827.     MVC   GLBFIRST,ANEWLB     RESET FIRST LB
  1828.     B     KRF6DUPN
  1829. KRF6DUPP EQU   *                   CHAIN PREVIOUS
  1830.     BAL   R14,CHKADDR
  1831.     MVC   LBNEXT,ANEWLB  SET NEXT IN PREV LB
  1832. KRF6DUPN EQU   *
  1833.     MVC   PREVDUP,ANEWLB
  1834.     L     R12,NEXTBLK
  1835.     CL    R12,BLK2LB       IS THIS LAST BLOCK
  1836.     BE    KRF6LAST         YES, GO SET NEXT POINTER
  1837.     MVC   NEXTBLK,LBNEXT  NEXT BLOCK TO DUP
  1838.     B     KRF6DUP
  1839. KRF6LAST EQU   *
  1840.     L     R12,PREVDUP
  1841.     BAL   R14,CHKADDR
  1842.     MVC   LBNEXT,SAVENEXT   SET NEXT IN LAST LB
  1843.     L     R12,SAVENEXT
  1844.     BAL   R14,CHKADDR
  1845.     MVC   LBPREV,PREVDUP    SET PREV IN NEXT LB
  1846.     BAL   R14,AUDITMS
  1847.     BAL   R14,PUTPCT
  1848.     BAL   R14,DISPLAY
  1849.     L     R14,KRSV14
  1850.     BR    R14
  1851. KRF7     EQU   *            F7 (SEARCH)
  1852.     ST    R14,KRSV14
  1853.     LA    R1,=CL20'KEY='
  1854.     BAL   R14,PUTMSG
  1855.     BAL   R14,UPDATE   UPDATE MEMORY FROM SCREEN
  1856.     LA    R1,4         SET STARTING COL IN STATMSG
  1857.     BAL   R14,GETWORD  GET SEARCH KEY
  1858.     CLI   LWORD,L'WORD
  1859.     BNL   KRF7ABT2     EXIT NOW IF LENGTH ZERO OR ABORTED
  1860.     MVC   LKEYWORD,LWORD
  1861.     MVC   KEYWORD,WORD
  1862.     XC    FINDKEY,FINDKEY     CLEAR TRT TABLE
  1863.     MVI   FINDKEY+ASCLF,ASCLF SET END OF RECORD TRAP
  1864.     SR    R1,R1
  1865.     IC    R1,KEYWORD
  1866.     STC   R1,FINDKEY(R1)      SET TRAP FOR FIRST CHAR.
  1867.     LA    R6,20
  1868.     BAL   R14,SETCUR
  1869.     LA    R1,=CL20'REPLACE Y/N/G (CR=N)'
  1870.     BAL   R14,PUTMSG
  1871.     BAL   R14,GETKEY
  1872.     MVC   WLBNEXT,SCBADDR
  1873.     MVC   PCURSRCH,PCURLINE
  1874.     SP    PCURSRCH,=P'1'
  1875.     MVI   REPLACE,FALSE       ASSUME NO REPLACE
  1876.     MVI   GLOBAL,FALSE        ASSUME NO GLOBAL REPLACE
  1877.     OI    KEY,X'20'
  1878.     CLI   KEY,X'79'     IS THIS A Y
  1879.     BE    KRF7REP       YES, GO GET REPLACE WORD
  1880.     CLI   KEY,X'67'     IS THIS A G (GLOBAL SERACH AND REPLACE)
  1881.     BNE   KRF7STRT      NO, GO SEARCH ONLY
  1882.     MVI   GLOBAL,TRUE   YES, SET GLOBAL REPLACE
  1883. KRF7REP  EQU   *
  1884.     LA    R1,=CL20'REP='
  1885.     BAL   R14,PUTMSG
  1886.     LA    R1,4
  1887.     BAL   R14,GETWORD     GET REPLACE WORD IN WORD
  1888.     CLI   LWORD,X'AB'
  1889.     BE    KRF7ABT2        EXIT IF GETWORD ABORT
  1890.     MVC   LREPWORD,LWORD
  1891.     MVC   REPWORD,WORD    SAVE IN REPWORD
  1892.     MVI   REPLACE,TRUE    SET REPLACE MODE
  1893. KRF7STRT EQU   *
  1894.     LA    R1,=CL20'SEARCHING'
  1895.     CLI   REPLACE,TRUE
  1896.     BNE   KRF7SRCH
  1897.     LA    R1,=CL20'REPLACING'
  1898. KRF7SRCH EQU   *
  1899.     BAL   R14,PUTMSG
  1900.     LA    R7,100
  1901. KRF7NXTL EQU   *               START SEARCH OF NEXT LINE
  1902.     L     R12,WLBNEXT
  1903.     LTR   R12,R12
  1904.     BZ    KRF7NOTF        EXIT IF NOT FOUND
  1905.     AP    PCURSRCH,=P'1'
  1906.     MVC   WLB(LLB),LB   MOVE NEXT LB TO WLB
  1907.     SR    R3,R3
  1908.     LA    R1,WLBLINE
  1909.     BCT   R7,KRF7NXTC
  1910.     LA    R0,X'0100'
  1911.     SVC   KEYBOARD
  1912.     STCM  R0,4,PWORK      STORE LOW FLAGS
  1913.     TM    PWORK,X'40'     IS THERE A KEY WAITING
  1914.     BZ    KRF7ABT1        YES, ABORT NOT FOUND
  1915.     LA    R7,100
  1916.     MVC   STATREC,=X'402020202020' UPDATE LINE BEING SEARCHED
  1917.     ED    STATREC,PCURSRCH
  1918.     ZAP   PCURLINE,PCURSRCH
  1919.     LA    R3,STATREC
  1920.     LA    R4,L'STATREC
  1921.     BAL   R14,PUTSTAT
  1922.     SR    R3,R3
  1923.     LA    R1,WLBLINE
  1924. KRF7NXTC EQU   *               SEARCH TO NEXT MATCHING FIRST CHAR.
  1925.     TRT   0(L'WLBLINE,R1),FINDKEY FIRST CHAR. FOUND
  1926.     CLM   R2,1,=AL1(ASCLF) IS THIS END OF RECORD
  1927.     BE    KRF7NXTL        YES, NEXT LINE
  1928.     IC    R3,LKEYWORD
  1929.     EX    R3,CLCKEYW      DOES ENTIRE KEYWORD MATCH
  1930.     BE    KRF7HIT         YES, EXIT WITH MATCHING LINE AT TOP
  1931.     LA    R1,1(R1)        NO,  SKIP MATCHING CHARACTER
  1932.     B     KRF7NXTC        REPEAT SEARCH TO END OF LINE
  1933. KRF7HIT  EQU   *               KEY FOUND
  1934.     ST    R12,GLBCUR      MOVE LINE TO TOP OF SCREEN
  1935.     MVC   PCUR,PCURSRCH
  1936.     CLI   REPLACE,TRUE
  1937.     BNE   KRF7EXIT
  1938.     MVI   FILEMOD,TRUE    RELEASE 1.4 FIX  ****************
  1939.     LA    R4,1(R1,R3)     R4=A(TEXT BEYOND KEY IN WLBLINE)
  1940.     MVC   SAVETEXT,0(R4)
  1941.     LA    R2,WLBLINE+L'WLBLINE-2
  1942.     SR    R2,R1           R2 = L'REMAINING TEXT IN WLBLINE-2
  1943.     LR    R4,R1           ASSUME NO REP
  1944.     CLI   LREPWORD,X'FF'  IS THERE ANY REP
  1945.     BE    KRF7MTXT        NO, GO OVERLAY KEY WTTH TEXT
  1946.     IC    R3,LREPWORD
  1947.     SR    R2,R3           R2 = L'TEXT BEYOND REP IN WLBLINE-1
  1948.     BM    KRF7HITE        DON'T REPLACE IF IT WON'T FIT
  1949.     EX    R3,MVCREP       MOVE REP OVER KEY
  1950.     LA    R4,1(R1,R3)     R4 = A(TEXT BEYOND REP)
  1951. KRF7MTXT EQU   *
  1952.     EX    R2,MVCTXT       MOVE REMAINING TEXT BEHIND REP
  1953.     BAL   R14,CHKADDR
  1954.     MVC   LB(LLB),WLB UPDATE LB WITH REPLACEMENT
  1955. KRF7HITE EQU   *
  1956.     CLI   GLOBAL,TRUE
  1957.     BNE   KRF7EXIT
  1958.     LA    R1,1(R1)
  1959.     B     KRF7NXTC
  1960. KRF7ABT1 EQU   *
  1961.     LA    R0,X'0000'     FLUSH INTERRUPT KEY
  1962.     SVC   KEYBOARD
  1963. KRF7ABT2 EQU   *
  1964.     LA    R1,=CL20'ABORT SEARCH'
  1965.     BAL   R14,PUTMSG
  1966.     B     KRF7EXIT
  1967. KRF7NOTF EQU   *
  1968.     LA    R1,=CL20'NOT FOUND'
  1969.     BAL   R14,PUTMSG
  1970. KRF7EXIT EQU   *
  1971.     BAL   R14,AUDITMS
  1972.     BAL   R14,DISPLAY
  1973.     L     R14,KRSV14
  1974.     BR    R14
  1975. CLCKEYW  CLC   0(0,R1),KEYWORD  COMPARE ENTIRE KEYWORD
  1976. MVCREP   MVC   0(0,R1),REPWORD  MOVE REP OVERLAYING KEY
  1977. MVCTXT   MVC   0(0,R4),SAVETEXT MOVE REMAINING TEXT BEHIND REP
  1978.     TITLE 'GETWORD - READ STRING FROM KEYBOARD WORD'
  1979. *
  1980. *        R1 = STARTING COL IN STATMSG
  1981. *        LWORD = LENGTH - 1 OR X'FF' IF NONE OR X'AB' IF ABORTED
  1982. *
  1983. GETWORD  EQU   *
  1984.     ST    R14,GETWSV14
  1985.     ST    R5,SAVEROW
  1986.     ST    R6,SAVECOL
  1987.     LR    R6,R1
  1988.     BAL   R14,SETCUR   UPDATE LINE AND COL BEFORE CHANGING
  1989.     L     R5,STATROW
  1990.     LA    R3,WORD
  1991.     LA    R4,L'WORD
  1992. GETWLOOP EQU   *
  1993.     STM   R3,R4,GETWSV34
  1994.     BAL   R14,SETCUR
  1995.     LA    R0,X'0920'  AH=9, AL= ASCII BLANK
  1996.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  1997.     IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.
  1998.     LA    R14,1       CX=(COUNT OF CHAR TO WRITE)
  1999.     SVC   VIDEO       DISPLAY BLANK AT CURSOR
  2000.     BAL   R14,GETKEY
  2001.     LM    R3,R4,GETWSV34
  2002.     CLI   KEY,ASCBS
  2003.     BNE   GETWCHKA
  2004.     CL    R3,=A(WORD)
  2005.     BNH   GETWLOOP     IGNORE BS IF AT BEGINNING
  2006.     BCTR  R3,0
  2007.     LA    R4,1(R4)
  2008.     BCTR  R6,0
  2009.     B     GETWLOOP
  2010. GETWCHKA EQU   *
  2011.     CLI   KEY,ASCCR
  2012.     BE    GETWOK
  2013.     CLI   KEY,X'20'
  2014.     BL    GETWQUIT
  2015.     CLI   KEY,X'80'
  2016.     BNL   GETWQUIT
  2017.     LA    R1,STATMSG(R6)
  2018.     MVC   0(1,R1),KEY
  2019.     LA    R0,X'0900'  AH=9
  2020.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE)
  2021.     IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.
  2022.     LA    R14,1       CX=(COUNT CHAR)
  2023.     IC    R0,KEY      AL=CHAR
  2024.     SVC   VIDEO       DISPLAY CHAR
  2025.     LA    R6,1(R6)
  2026.     MVC   0(1,R3),KEY
  2027.     LA    R3,1(R3)
  2028.     BCT   R4,GETWLOOP
  2029. GETWQUIT EQU   *
  2030.     MVI   LWORD,X'AB'
  2031.     B     GETWEXIT
  2032. GETWOK   EQU   *
  2033.     LA    R3,L'WORD-1
  2034.     SR    R3,R4
  2035.     STC   R3,LWORD        SAVE LENGTH (X'FF' = NO CHAR)
  2036. GETWEXIT EQU   *
  2037.     L     R5,SAVEROW
  2038.     L     R6,SAVECOL
  2039.     BAL   R14,SETCUR
  2040.     L     R14,GETWSV14
  2041.     BR    R14
  2042. KRF8     EQU   *            REPEAT F7 SEARCH
  2043.     ST    R14,KRSV14
  2044.     MVC   WLBNEXT,SCBNEXT
  2045.     ZAP   PCURSRCH,PCURLINE
  2046.     B     KRF7STRT
  2047. KRF9     EQU   *            SELECT COLOR
  2048.     ST    R14,KRSV14
  2049.     SR    R1,R1
  2050.     IC    R1,ATTRIB
  2051.     LR    R2,R1
  2052.     N     R1,=X'000000F0' R1 = LEFT NIBBLE * 16
  2053.     N     R2,=X'0000000F' R2 = RIGHT NIBBLE
  2054.     ST    R5,SAVEROW
  2055.     ST    R6,SAVECOL
  2056.     LA    R6,15
  2057. KRF9LOOP EQU   *
  2058.     LA    R0,0(R1,R2)
  2059.     STC   R0,ATTRIB        UPDATE ATTRIB
  2060.     STM   R1,R2,KRF9SV12   SAVE R1-R2 ACROSS I/O
  2061.     MVC   STATMSG,=CL20'COLOR BRGBIRGB'
  2062.     BAL   R14,DHEXATT
  2063.     LA    R3,STATMSG
  2064.     LA    R4,L'STATMSG
  2065.     BAL   R14,PUTSTAT
  2066.     L     R5,STATROW
  2067.     LA    R15,0(R5,R6)
  2068.     LA    R0,X'0200'      AH=2 SET CURSOR
  2069.     LA    R1,0            BH=0 PAGE
  2070.     SVC   VIDEO
  2071.     L     R5,SAVEROW
  2072.     BAL   R14,GETKEY       GET NEXT KEY (CR,ARROWS,0-9,A-F)
  2073.     LM    R1,R2,KRF9SV12
  2074.     CLI   KEY,ASCCR        CR TO EXIT F9 WITH CURRENT ATTRIB
  2075.     BE    KRF9EXIT
  2076.     CLI   KEY,ASCUP        UP ARROW TO INCR CURRENT NIBBLE
  2077.     BNE   KRF9CKDN
  2078. KRF9UP   EQU   *
  2079.     CLM   R6,1,=AL1(15)
  2080.     BNE   KRF9UP2
  2081.     LA    R1,16(R1)
  2082.     N     R1,=X'000000F0'
  2083.     B     KRF9LOOP
  2084. KRF9UP2  EQU   *
  2085.     LA    R2,1(R2)
  2086.     N     R2,=X'0000000F'
  2087.     B     KRF9LOOP
  2088. KRF9CKDN EQU   *
  2089.     CLI   KEY,ASCDOWN    DOWN ARROW TO DEC CURRENT NIBBLE
  2090.     BNE   KRF9CHLF
  2091.     CLM   R6,1,=AL1(15)
  2092.     BNE   KRF9DN2
  2093.     SH    R1,=H'16'
  2094.     N     R1,=X'000000F0'
  2095.     B     KRF9LOOP
  2096. KRF9DN2  EQU   *
  2097.     BCTR  R2,0
  2098.     N     R2,=X'0000000F'
  2099.     B     KRF9LOOP
  2100. KRF9CHLF EQU   *
  2101.     CLI   KEY,ASCLEFT    LEFT ARROW TO SELECT LEFT NIBBLE
  2102.     BNE   KRF9CHRG
  2103.     LA    R6,15
  2104.     B     KRF9LOOP
  2105. KRF9CHRG EQU   *
  2106.     CLI   KEY,ASCRGHT    RIGHT ARROW TO SELECT RIGHT NIBBLE
  2107.     BNE   KRF9HEX
  2108.     LA    R6,16
  2109.     B     KRF9LOOP
  2110. KRF9HEX  EQU   *
  2111.     CLI   KEY,X'80'
  2112.     BNL   KRF9LOOP
  2113.     TR    KEY,HEXTAB     CONVERT ASCII KEY TO 0-F OR FF
  2114.     CLI   KEY,X'FF'
  2115.     BE    KRF9LOOP       IGNORE INVALID CHAR.
  2116.     SR    R0,R0
  2117.     IC    R0,KEY
  2118.     CLM   R6,1,=AL1(15)
  2119.     BNE   KRF9HEX2
  2120.     SLL   R0,4
  2121.     LR    R1,R0          SET LEFT NIBBLE
  2122.     LA    R6,16          SWITCH NIBBLE
  2123.     B     KRF9LOOP
  2124. KRF9HEX2 EQU   *
  2125.     LR    R2,R0          SET RIGHT NIBBLE
  2126.     LA    R6,15          SWITCH NIBBLE
  2127.     B     KRF9LOOP
  2128. KRF9EXIT EQU   *
  2129.     LA    R0,X'0B00'     AH=11 FOR SET COLOR PALETTE (TECH. A-49)
  2130.     SR    R1,R1
  2131.     IC    R1,ATTRIB
  2132.     SRL   R1,4
  2133.     N     R1,=X'00000007' SET BACKGROUND T SAME AS ATTRIB
  2134.     SVC   VIDEO
  2135.     BAL   R14,NEWSTAT     REFRESH STATUS LINE WITH NEW ATTRIBUTE
  2136.     L     R5,SAVEROW
  2137.     L     R6,SAVECOL
  2138.     BAL   R14,SETCUR
  2139.     L     R14,KRSV14
  2140.     BR    R14
  2141. DHEXATT  EQU   *            DISPLAY ATTRIBUTE IN HEX
  2142.     SR    R1,R1
  2143.     IC    R1,ATTRIB
  2144.     SRL   R1,4
  2145.     IC    R1,HEX(R1)
  2146.     STC   R1,STATMSG+15
  2147.     IC    R1,ATTRIB
  2148.     N     R1,=X'0000000F'
  2149.     IC    R1,HEX(R1)
  2150.     STC   R1,STATMSG+16
  2151.     BR    R14
  2152. KRF10    EQU   *            BOX GRAPHICS
  2153.     ST    R14,KR10SV14
  2154.     CLI   BOX,TRUE     IF BOX MODE ON, TURN IT OFF
  2155.     BE    KRF10OFF     ELSE TURN IT ON
  2156.     MVI   BOX,TRUE
  2157.     MVI   BLKLABEL,FALSE    TURN OFF BLOCK MODE
  2158.     MVC   STATBLK,=C'BOX'   DISPLAY BOX MODE USING BLK IND.
  2159.     LA    R3,STATBLK
  2160.     LA    R4,L'STATBLK
  2161.     BAL   R14,PUTSTAT
  2162.     CLI   KBINS,INSSTATE    IF INSERT MODE ON, TURN IT OFF
  2163.     BNE   KRF10EXT
  2164.     BAL   R14,KRINS
  2165.     B     KRF10EXT
  2166. KRF10OFF EQU   *
  2167.     MVI   BOX,FALSE
  2168.     MVC   STATBLK,=C'   '
  2169.     LA    R3,STATBLK
  2170.     LA    R4,L'STATBLK
  2171.     BAL   R14,PUTSTAT
  2172. KRF10EXT EQU   *
  2173.     L     R14,KR10SV14
  2174.     BR    R14
  2175. KRSHF1   EQU   *            SHIFT F1 (QUICK SAVE)
  2176.     ST    R14,KRSV14
  2177.     BAL   R14,SAVEFILE  SAVE FILE NOW AND RESET FILEMOD
  2178.     L     R14,KRSV14
  2179.     BR    R14
  2180. KRSHF10  EQU   *            SWITCH BOX GRAPHIC CHARACTER SET
  2181.     ST    R14,KRSV14
  2182.     L     R1,BOXSETA   ADDRESS OF BOX GRAPHIC CHARACTERS
  2183.     CLI   CONNECT,TRUE
  2184.     BE    KRSHF10A     GO TOGGLE SET1/SET2 IN CONNECT MODE
  2185.     LA    R1,8(R1)     INCR TO NEXT SET
  2186.     CL    R1,=A(BOXSETE) IS THIS END OF TABLE
  2187.     BL    KRSHF10S
  2188.     LA    R1,BOXSET    YES, RESET TO FIRST SET
  2189.     B     KRSHF10S
  2190. KRSHF10A EQU   *
  2191.     CL    R1,=A(BOXSET1)  IF SET1, SWITCH TO SET 2
  2192.     BE    KRSHF102
  2193. KRSHF101 EQU   *
  2194.     LA    R1,BOXSET1
  2195.     B     KRSHF10S
  2196. KRSHF102 EQU   *
  2197.     LA    R1,BOXSET2
  2198. KRSHF10S EQU   *
  2199.     ST    R1,BOXSETA   UPDATE BOX SET POINTER
  2200. KRPRTSET EQU   *
  2201.     LA    R1,=CL20'BOX CHAR = '
  2202.     BAL   R14,PUTMSG
  2203.     L     R1,BOXSETA
  2204.     MVC   STATMSG+11(8),0(R1)
  2205.     MVI   STATMSG+19,X'00'
  2206.     SR    R1,R1
  2207.     IC    R1,ATTRIB
  2208.     LA    R2,STATMSG+11
  2209.     L     R15,STATROW
  2210.     LA    R15,11(R15)
  2211.     SVC   PRINTTXT      PRINT GRAPHIC BOX CHARACTERS
  2212.     L     R14,KRSV14
  2213.     BR    R14
  2214. KRALTF10 EQU   *             TOGGLE CONNECT MODE
  2215.     ST    R14,KRSV14
  2216.     CLI   CONNECT,TRUE
  2217.     BE    KRAF10R
  2218.     MVI   CONNECT,TRUE        SET CONNECT ON WITH SINGLE LINE
  2219.     MVC   BOXSETA,=A(BOXSET1)
  2220.     LA    R1,=CL20'CONNECT MODE SET'
  2221.     BAL   R14,PUTMSG
  2222.     L     R14,KRSV14
  2223.     BR    R14
  2224. KRAF10R  EQU   *
  2225.     MVI   CONNECT,FALSE
  2226.     LA    R1,=CL20'CONNECT MODE OFF'
  2227.     BAL   R14,PUTMSG
  2228.     L     R14,KRSV14
  2229.     BR    R14
  2230. KRALTF1  EQU   *             ALT-F1 PAUSE UNTIL KEY HIT
  2231.     ST    R14,KRWTSV14
  2232.     CLI   KSMODE,KSREAD
  2233.     BE    KRAF1GET
  2234.     LA    R1,=CL20'PAUSE'
  2235.     BAL   R14,PUTMSG
  2236.     B     KRALTEXT
  2237. KRAF1GET EQU   *
  2238.     LA    R1,=CL20'PAUSE - PRESS ENTER'
  2239.     BAL   R14,PUTMSG
  2240.     LA    R0,X'0000'
  2241.     SVC   KEYBOARD      READ NEXT KEY AND IGNORE
  2242. KRALTEXT EQU   *
  2243.     L     R14,KRWTSV14
  2244.     BR    R14
  2245. KRALTF2  EQU   *             ALT-F2 WAIT A SECOND
  2246.     ST    R14,KRWTSV14
  2247.     LA    R1,=CL20'WAIT A SECOND'
  2248.     BAL   R14,PUTMSG
  2249.     CLI   KSMODE,KSREAD
  2250.     BNE   KRALTEXT
  2251.     L     R1,=A(3000)   SET WAIT LOOP COUNT
  2252. KRALTF2L EQU   *
  2253.     BCT   R1,KRALTF2L
  2254.     L     R14,KRWTSV14
  2255.     BR    R14
  2256. KRALTF3  EQU   *            ENTER DEBUG MODE
  2257.     ST    R14,KRSV14
  2258.     SVC   TRACE
  2259.     DC    C'BUG '
  2260.     BAL   R14,NEWSTAT  CLEAN UP SCREEN AFTER DEBUG
  2261.     BAL   R14,DISPLAY
  2262.     L     R14,KRSV14
  2263.     BR    R14
  2264. KRALTF4  EQU   *            TOGGLE AUDIT MODE
  2265.     ST    R14,KRSV14
  2266.     XI    AUDIT,TRUE
  2267.     CLI   AUDIT,TRUE
  2268.     LA    R1,=CL20'AUDIT MODE ON'
  2269.     BE    KRAF4MSG
  2270.     LA    R1,=CL20'AUDIT MODE OFF'
  2271. KRAF4MSG EQU   *
  2272.     BAL   R14,PUTMSG
  2273.     L     R14,KRSV14
  2274.     BR    R14
  2275. KRALTF5  EQU   *            GOTO LINE #
  2276.     ST    R14,KRSV14
  2277.     LA    R1,=CL20'LINE='
  2278.     BAL   R14,PUTMSG
  2279.     LA    R1,5
  2280.     BAL   R14,GETWORD
  2281.     CLI   LWORD,L'WORD
  2282.     BNL   KRA5ERR         IF LENGTH 0, IGNORE
  2283.     SR    R1,R1
  2284.     IC    R1,LWORD
  2285.     EX    R1,TRTWORD
  2286.     BNZ   KRA5ERR         IF NOT ASCII NUMERIC, IGNORE
  2287.     EX    R1,PCKWORD
  2288.     OI    PWORD+L'PWORD-1,X'0F' CONVERT ASCII DIGIT SIGN
  2289.     CP    PWORD,PLSTLINE  IF PAST END, IGNORE
  2290.     BH    KRA5ERR
  2291.     CP    PWORD,=P'1'
  2292.     BL    KRA5ERR         IF NOT GE 1, IGNORE
  2293.     CP    PWORD,PCUR
  2294.     BL    KRA5LOW         LINE IS BELOW CURRENT LINE
  2295.     ZAP   PWORK,PLSTLINE
  2296.     SP    PWORK,PWORD     PWORK IS DISTANCE FROM END
  2297.     ZAP   PWORK1,PWORD
  2298.     SP    PWORK1,PCUR     PWORK1 IS DISTANCE FROM CUR
  2299.     CP    PWORK,PWORK1    IS IT SHORTER VIA PCUR OR PLSTLINE
  2300.     BH    KRA5FWD         GO FORWARD FROM CURRENT POS.
  2301.     ZAP   PCUR,PLSTLINE
  2302.     MVC   GLBCUR,GLBLAST
  2303.     B     KRA5BAK          GO BACKWORD FROM END
  2304. TRTWORD  TRT   WORD(0),NUMERIC  TEST WORD FOR NUMERIC LINE #
  2305. PCKWORD  PACK  PWORD,WORD(0)    PACK WORD
  2306. KRA5LOW  EQU   *
  2307.     ZAP   PWORK,PCUR
  2308.     SP    PWORK,PWORD PWORK IS DISTANCE FROM CUR
  2309.     CP    PWORK,PWORD IS IT SHORTER FROM START OR CUR
  2310.     BL    KRA5BAK     GO BACKWARD FROM CUR
  2311.     ZAP   PCUR,=P'1'
  2312.     MVC   GLBCUR,GLBFIRST
  2313. KRA5FWD  EQU   *           GO FORWARD FROM PCUR TO PWORD
  2314.     CP    PCUR,PWORD
  2315.     BE    KRA5EXIT
  2316.     L     R12,GLBCUR
  2317.     MVC   WLBNEXT,LBNEXT
  2318.     CLC   WLBNEXT,=A(0)
  2319.     BE    KRA5ERR      ERROR IF EOF FOUND
  2320.     AP    PCUR,=P'1'
  2321.     MVC   GLBCUR,WLBNEXT
  2322.     B     KRA5FWD
  2323. KRA5BAK  EQU   *           GO BACKWARD FROM PCUR TO PWORD
  2324.     CP    PCUR,PWORD
  2325.     BE    KRA5EXIT
  2326.     L     R12,GLBCUR
  2327.     MVC   WLBPREV,LBPREV
  2328.     CLC   WLBPREV,=A(0)
  2329.     BE    KRA5ERR      ERROR IF EOF FOUND
  2330.     SP    PCUR,=P'1'
  2331.     MVC   GLBCUR,WLBPREV
  2332.     B     KRA5BAK
  2333. KRA5ERR  EQU   *
  2334.     LA    R1,=CL20'INVALID LINE #'
  2335.     BAL   R14,PUTMSG
  2336. KRA5EXIT EQU   *
  2337.     BAL   R14,DISPLAY
  2338.     L     R14,KRSV14
  2339.     BR    R14
  2340. KRBS     EQU   *            BACK SPACE
  2341.     ST    R14,KRSV14
  2342.     LTR   R6,R6
  2343.     BZ    KRDELCHR
  2344.     BCTR  R6,0
  2345.     SP    PCOL,=P'1'
  2346.     BAL   R14,SETCUR
  2347.     L     R14,KRSV14
  2348.     B     KRDELCHR
  2349. KRHT     EQU   *            HORIZONTAL TAB
  2350.     ST    R14,KRSV14
  2351.     CH    R6,=H'9'
  2352.     BL    KRHTC10
  2353.     CH    R6,=H'15'
  2354.     BL    KRHTC16
  2355.     N     R6,=X'000000FC' FORCE TO MULTIPLE OF 4
  2356.     CVD   R6,PWORK
  2357.     ZAP   PCOL,PWORK
  2358.     AP    PCOL,=P'1'
  2359.     LA    R6,4(R6)        ADD 4
  2360.     AP    PCOL,=P'4'
  2361.     CH    R6,=H'79'
  2362.     BNH   KRHTEXIT
  2363. KRHTC0   EQU   *
  2364.     SR    R6,R6
  2365.     ZAP   PCOL,=P'1'
  2366.     B     KRHTEXIT
  2367. KRHTC10  EQU   *
  2368.     LA    R6,10-1
  2369.     ZAP   PCOL,=P'10'
  2370.     B     KRHTEXIT
  2371. KRHTC16  EQU   *
  2372.     LA    R6,16-1
  2373.     ZAP   PCOL,=P'16'
  2374. KRHTEXIT EQU   *
  2375.     BAL   R14,SETCUR
  2376.     L     R14,KRSV14
  2377.     BR    R14
  2378. KRHTAUTO EQU   *          TOGGLE AUTO TAB MODE
  2379.     XI    HTMODE,TRUE
  2380.     BR    R14
  2381. KRCTLK   EQU   *          ROUTE TO CTL-K B,C,D,K,Q,Y
  2382.     ST    R14,KRSV14
  2383.     BAL   R14,GETKEY
  2384.     L     R14,KRSV14
  2385.     OI    KEY,X'40'  MAKE CTL A-Z = A-Z
  2386.     CLI   KEY,X'42'
  2387.     BE    KRF5       CTL-K B  F5 MARK BLOCK BEGIN
  2388.     CLI   KEY,X'43'
  2389.     BE    KRF6       CTL-K C  F6 DUPLICATE BLOCK
  2390.     CLI   KEY,X'44'
  2391.     BE    KRESC      CTL-K D  ESCAPE
  2392.     CLI   KEY,X'4B'
  2393.     BE    KRF5       CTL-K K  F5 MARK BLOCK END
  2394.     CLI   KEY,X'51'
  2395.     BE    KRBREAK    CTL-K Q  CONTROL BREAK
  2396.     CLI   KEY,X'59'
  2397.     BE    KRCTLKY    CTL-K Y  DELETE BLOCK
  2398.     BR    R14
  2399. KRCTLQ   EQU   *          ROUTE TO CTL-Q A,C,D,F,I,R,S
  2400.     ST    R14,KRSV14
  2401.     BAL   R14,GETKEY
  2402.     L     R14,KRSV14
  2403.     OI    KEY,X'40'  MAKE CTL A-Z = A-Z
  2404.     CLI   KEY,X'41'
  2405.     BE    KRF7       CTL-Q A  F7 SEARCH/REPLACE
  2406.     CLI   KEY,X'43'
  2407.     BE    KREND      CTL-Q C  END
  2408.     CLI   KEY,X'44'
  2409.     BE    KRF4       CTL-Q D  END OF LINE
  2410.     CLI   KEY,X'46'
  2411.     BE    KRF7       CTL-Q F  F7 SEARCH/REPLACE
  2412.     CLI   KEY,X'49'
  2413.     BE    KRHTAUTO   CTL-Q I  AUTO TAB
  2414.     CLI   KEY,X'52'
  2415.     BE    KRHOME     CTL-Q R  HOME
  2416.     CLI   KEY,X'53'
  2417.     BE    KRF3       CTL-Q S  START OF LINE
  2418.     BR    R14
  2419. KRBREAK  EQU   *          CTL-K Q  BREAK
  2420.     SVC   EXIT
  2421.     TITLE 'CHKMARK - IF IN MARK MODE, PRINT IN REVERSE VIDEO'
  2422. CHKMARK  EQU   *
  2423.     CLI   BLKLABEL,MARK
  2424.     BNER  R14
  2425.     ST    R14,CHKMSV14
  2426.     CLI   KEY,ASCUP     IS CURRENT KEY UP
  2427.     BNE   CHKMARK1
  2428.     MVI   BLKLABEL,FALSE  TURN OFF MARKING ON UP ARROW
  2429. CHKMARK1 EQU   *
  2430.     SR    R3,R3
  2431.     BAL   R14,PUTLINE
  2432.     MVI   BLKLABEL,MARK  RESET MARKING
  2433.     L     R14,CHKMSV14
  2434.     BR    R14
  2435.     TITLE 'UPDATE - UPDATE SCREEN LINES IN EXTENDED STORAGE'
  2436. UPDATE   EQU   *
  2437.     ST    R14,UPDTSV14
  2438.     CLI   SCRMOD,TRUE   HAS SCREEN BEEN MODIFIED
  2439.     BNER  R14           NO, EXIT NOW
  2440.     MVI   FILEMOD,TRUE  SET FILE MODIFY SWITCH
  2441.     MVI   SCRMOD,FALSE  RESET SCREEN MODIFY SWITCH
  2442.     LR    R2,R7         SAVE R7
  2443.     L     R7,ASCB
  2444.     USING SCB,R7
  2445. UPDTLOOP EQU   *
  2446.     CLI   SCBMOD,TRUE
  2447.     BNE   UPDTNEXT
  2448.     L     R12,SCBADDR
  2449.     BAL   R14,CHKADDR
  2450.     USING LB,R12
  2451.     MVC   LBLINE(L'SCBLINE),SCBLINE
  2452. UPDTNEXT EQU   *
  2453.     LA    R7,LSCB(R7)
  2454.     CL    R7,LASTSCB
  2455.     BNH   UPDTLOOP
  2456.     LR    R7,R2         RESTORE R7
  2457.     BAL   R14,AUDITMS
  2458.     L     R14,UPDTSV14
  2459.     BR    R14
  2460.     TITLE 'CHKADDR - VALIDATE SCB ADDRESS BEFORE WRITE'
  2461. CHKADDR  EQU   *
  2462.     CL    R12,MINMEM
  2463.     BL    E05
  2464.     CL    R12,MAXMEM
  2465.     BNL   E05
  2466.     BR    R14
  2467.     TITLE 'GETNEWLB - ALLOCATE NEW LB SPACE IN EXT. MEMORY IF AVAIL.'
  2468. GETNEWLB EQU   *
  2469.     L     R1,GFQEL      IS THERE ROOM FOR LB LEFT IN PRIMARY AREA
  2470.     SH    R1,=AL2(LLB)
  2471.     BM    CHKFREE       NO, GO CHECK FREE QUEUE
  2472.     ST    R1,GFQEL      UDATE LENGTH OF PRIMARY AREA
  2473.     L     R1,GFQEA
  2474.     ST    R1,ANEWLB     SET ADDRESS OF ALLOCATED LB
  2475.     LA    R1,LLB(R1)
  2476.     ST    R1,GFQEA      UPDATE ADDRESS
  2477.     B     GETMEXIT
  2478. CHKFREE  EQU   *
  2479.     L     R1,AFREELB    IS THERE AN LB ON FREE QUEUE
  2480.     LTR   R1,R1
  2481.     BZ    GETMERR       NO, EXIT WITH ERROR
  2482.     ST    R1,ANEWLB     SET ADDRESS OF ALLOCATED LB
  2483.     LR    R12,R1
  2484.     MVC   AFREELB,LBNEXT  UPDATE NEXT FREE LB
  2485. GETMEXIT EQU   *
  2486.     SR    R15,R15
  2487.     BR    R14
  2488. GETMERR  EQU   *
  2489.     ST    R14,GETMSV14
  2490.     LA    R1,=CL20'** OUT OF MEMORY **'
  2491.     BAL   R14,PUTMSG
  2492.     LA    R15,4
  2493.     L     R14,GETMSV14
  2494.     BR    R14
  2495.     TITLE 'ERROR MESSAGES'
  2496. E01      EQU   *
  2497.     LA    R2,=C'E01 - I/O ERROR ON INPUT FILE$'
  2498. ERR      EQU   *
  2499.     SVC   WTO
  2500.     SVC   TRACE
  2501.     DC    C'ERR '
  2502.     SVC   TRACE
  2503.     DC    C'BUG '
  2504.     SVC   EXIT
  2505. E02      EQU   *
  2506.     LA    R2,=C'E02 - MS-DOS EXTENDED MEMORY ALLOCATION ERROR$'
  2507.     B     ERR
  2508. E03      EQU   *
  2509.     LA    R2,=C'E03 - NO MEMORY AVAILABLE FOR ADDITIONAL RECORD$'
  2510.     LA    R15,3
  2511.     BR    R14
  2512. E04      EQU   *
  2513. EOFUT2   EQU   *
  2514.     LA    R2,=C'E04 - EOF ON KEYBOARD SIMULATOR FILE$'
  2515.     B     ERR
  2516. E05      EQU   *
  2517.     LA    R2,=C'E05 - INVALID EXTENDED MEMORY ADDRESS$'
  2518.     B     ERR
  2519.     TITLE 'DATA SECTION'
  2520.     LTORG
  2521. *
  2522. * REGISTER USAGE
  2523. *
  2524. R0       EQU   0  WORK
  2525. R1       EQU   1  WORK
  2526. R2       EQU   2  WORK
  2527. R3       EQU   3  WORK
  2528. R4       EQU   4  WORK
  2529. R5       EQU   5  ROW IN 3RD BYTE
  2530. R6       EQU   6  COL IN 4TH BYTE
  2531. R7       EQU   7  BASE FOR SCREEN CONTROL BLOCK SCB
  2532. R8       EQU   8  FIRST  BASE
  2533. R9       EQU   9  SECOND BASE
  2534. R10      EQU   10 THIRD  BASE
  2535. R11      EQU   11 LENGTH FOR CROSS MEMORY MOVE
  2536. R12      EQU   12 BASE FOR LB IN EXTENDED STORAGE
  2537. R13      EQU   13 SAVE AREA
  2538. R14      EQU   14 LINK FROM MAINLINE TO ROUTINES
  2539. R15      EQU   15 RETURN CODE FROM ROUTINES
  2540. *
  2541. * PC/370 SVC'S
  2542. *
  2543. EXIT     EQU   0
  2544. OPEN     EQU   1
  2545. CLOSE    EQU   2
  2546. GET      EQU   5
  2547. PUT      EQU   6
  2548. DELETE   EQU   7
  2549. SEARCH   EQU   8
  2550. TRACE    EQU   9
  2551. GETMAIN  EQU   10
  2552. FREEMAIN EQU   11
  2553. ASCEBC   EQU   12
  2554. EBCASC   EQU   13
  2555. RENAME   EQU   23
  2556. PRINTTXT EQU   24     MICRO-CODE PRINTING OF TEXT ON ROW VIA PC/370
  2557. VIDEO    EQU   128+16 BIOS VIDEO-IO (TECH. REF. A-48)
  2558. KEYBOARD EQU   128+22 BIOS KEYBOARD (TECH. REF. A-26)
  2559. WRITECHR EQU   200+2  MS-DOS SVC 2 DISPLAY CHAR IN R2 ON CONSOLE
  2560. READKEY  EQU   200+7  MS-DOS SVC 7 GET KEY WITHOUT ECHO
  2561. WTO      EQU   200+9  MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
  2562. *
  2563. * DATA AREAS
  2564. *
  2565. ASCBS    EQU   X'08'   ASCII BACKSPACE
  2566. ASCLF    EQU   X'0A'   ASCII LINE FEED
  2567. ASCCR    EQU   X'0D'   ASCII CARRIAGE RETURN
  2568. ASCASK   EQU   X'2A'   ASCII ASTERISK FOR ALC COMMENT CHECK
  2569. ASCBLK   EQU   X'20'   ASCII SPACE
  2570. ASCTAB   EQU   X'09'   ASCII TAB
  2571. ASCRIGHT EQU   X'1C'   ASCII CURSOR RIGHT
  2572. ASCF1    EQU   X'BB'   EXTENDED ASCII F1 WITH HIGH BIT ON
  2573. ASCF2    EQU   X'BC'   EXTENDED ASCII F2 WITH HIGH BIT ON
  2574. ASCALTF1 EQU   X'E8'   EXTENDED ASCII ALT-F1 WITH HIGH BIT ON
  2575. ASCALTF2 EQU   X'E9'   EXTENDED ASCII ALT-F2 WITH HIGH BIT ON
  2576. ASCUP    EQU   X'C8'   EXTENDED ASCII UP ARROW WITH HIGH BIT ON
  2577. ASCDOWN  EQU   X'D0'   EXTENDED ASCII DOWN ARROW WITH HIGH BIT
  2578. ASCLEFT  EQU   X'CB'   EXTENDED ASCII LEFT ARROW
  2579. ASCRGHT  EQU   X'CD'   EXTENDED ASCII RIGHT ARROW
  2580. ESCAPE   EQU   X'1B'   ASCII ESCAPE KEY
  2581.     DC    C'**** KEY ****'
  2582. KEY      DC    X'00'   KEY FROM KEYBOARD OR EMULATOR FILE
  2583.     DC    C'*** LAST KEY ***'
  2584. LASTKEY  DC    X'00'   PREV KEY FROM KEYBOARD
  2585.     DC    C'**** WAITLOOP *****'
  2586. WAITLOOP DC    F'1'    DEFAULT WAIT LOOP IS 1
  2587. PWORD    DC    PL8'0'
  2588. WORD     DC    CL15' ' WORD READ VIA GET WORD
  2589. LWORD    DC    X'00'   LENGTH OF WORD READ-1 OR X'FF' IF ZERO
  2590. KEYWORD  DC    CL15' ' SEARCH KEY WORD
  2591. LKEYWORD DC    X'00'   SAVE LENGTH OF KEYWORD - 1 FOR F8
  2592. REPWORD  DC    CL15' ' REPLACE WORD
  2593. LREPWORD DC    X'00'   SAVE LENGTH OF REPLACE - 1 FOR F8
  2594. SAVETEXT DC    CL80' ' SAVE TEXT FOLLOWING KEY FOR REPLACE
  2595. FINDKEY  DC    XL256'00' TRT FOR FIRST CHAR. IN KEYWORD
  2596. NUMERIC  DC    48X'FF',10X'00',198X'FF' TRT ASCII NUMERIC TEST
  2597. HEX      DC    C'0123456789ABCDEF'   CONVERT NIBBLE TO EBCDIC
  2598. HEXTAB   DC    128X'FF'              CONVERT ASCII  TO NIBBLE
  2599.     ORG   HEXTAB+X'30'
  2600.     DC    AL1(0,1,2,3,4,5,6,7,8,9)  ASCII 0-9
  2601.     ORG   HEXTAB+X'41'
  2602.     DC    AL1(10,11,12,13,14,15)    ASCII A-F
  2603.     ORG   HEXTAB+X'61'
  2604.     DC    AL1(10,11,12,13,14,15)    ASCII A-F
  2605.     ORG   HEXTAB+128
  2606. *
  2607. *  KEY ROUTINE ADDRESS TABLE
  2608. *
  2609. KRTAB    DS    0F
  2610.     DC    A(0)    ZERO FUNCTION CODE NOT USED
  2611. KEYUND   DC    A(KRUND)   KEY UNDEFINED
  2612. KEYCHAR  DC    A(KRCHAR)  PROCESS CHARACTER UPDATE ON SCREEN
  2613. KEYESC   DC    A(KRESC)   ESCAPE KEY
  2614. KEYPGDN  DC    A(KRPGDN)  PAGE DOWN
  2615. KEYPGUP  DC    A(KRPGUP)  PAGE UP
  2616. KEYUP    DC    A(KRUP)    CURSOR UP
  2617. KEYLEFT  DC    A(KRLEFT)  CURSOR LEFT
  2618. KEYRIGHT DC    A(KRRIGHT) CURSOR RIGHT
  2619. KEYDOWN  DC    A(KRDOWN)  CURSOR DOWN
  2620. KEYINS   DC    A(KRINS)   INSERT
  2621. KEYDEL   DC    A(KRDEL)   DELETE
  2622. KEYCR    DC    A(KRCR)    CARRIAGE RETURN
  2623. KEYBS    DC    A(KRBS)    BACK SPACE
  2624. KEYHT    DC    A(KRHT)    HORIZONTAL TAB
  2625. KEYHOME  DC    A(KRHOME)  HOME (TOP OF FILE)
  2626. KEYEND   DC    A(KREND)   END  (END OF FILE)
  2627. KEYALTF1 DC    A(KRALTF1) ENTER PAUSE UNTIL KEY HIT FOR EMULATOR
  2628. KEYALTF2 DC    A(KRALTF2) ENTER WAIT FOR 1 SECOND FOR EMULATOR
  2629. KEYALTF3 DC    A(KRALTF3) ENTER DEBUG MODE
  2630. KEYALTF4 DC    A(KRALTF4) TOGGLE AUDIT MODE
  2631. KEYALTF5 DC    A(KRALTF5) GO TO LINE #
  2632. KEYALTFA DC    A(KRALTF10) TOGGLE CONNECT BOX GRAPHIC MODE
  2633. KEYF1    DC    A(KRF1)    F1 HELP SCREEN 1
  2634. KEYF2    DC    A(KRF2)    F2 HELP SCREEN 2
  2635. KEYF3    DC    A(KRF3)    F3 START OF LINE
  2636. KEYF4    DC    A(KRF4)    F4 END OF LINE
  2637. KEYF5    DC    A(KRF5)    F5 LABEL BLOCK
  2638. KEYF6    DC    A(KRF6)    F6 DUPLICATE BLOCK
  2639. KEYF7    DC    A(KRF7)    F7 SEARCH
  2640. KEYF8    DC    A(KRF8)    F8 REPEAT LAST F7 SEARCH
  2641. KEYF9    DC    A(KRF9)    F9 SELECT COLOR
  2642. KEYF10   DC    A(KRF10)   F10 BOX GRAPHICS
  2643. KEYSHF1  DC    A(KRSHF1)  SHIFT F1 QUICK SAVE
  2644. KEYSHF3  EQU   KEYF3      SHFT-F3 START OF LINE
  2645. KEYSHF4  EQU   KEYF4      SHFT-F4 END OF LINE
  2646. KEYSHF6  DC    A(KRSHF6)  SHIFT F6 DELETE LINE
  2647. KEYSHF7  DC    A(KRHTAUTO) SHIFT F7 AUTO TAB
  2648. KEYSHF9  DC    A(KRHTAUTO) SHIFT F9 AUTO TAB
  2649. KEYSHF10 DC    A(KRSHF10) SHIFT F10 (CHANGE BOX GRAPHIC CHAR SET)
  2650. KEYCTLC  EQU   KEYPGDN    CTL-C PAGE DOWN
  2651. KEYCTLD  EQU   KEYRIGHT   CTL-D CURSOR RIGHT
  2652. KEYCTLE  EQU   KEYUP      CTL-E CURSOR UP
  2653. KEYCTLG  EQU   KEYDEL     CTL-G DELETE
  2654. KEYCTLH  EQU   KEYBS      CTL-H BACKSPACE
  2655. KEYCTLI  EQU   KEYHT      CTL-I TAB
  2656. KEYCTLK  DC    A(KRCTLK)  CTL-K ROUTE TO B,C,D,K,Q,Y
  2657. KEYCTLL  EQU   KEYF8      CTL-L REPEAT SEARCH
  2658. KEYCTLN  EQU   KEYCR      CTL-N CARRIAGE RETURN OR ENTER
  2659. KEYCTLQ  DC    A(KRCTLQ)  CTL-Q ROUTE TO A,C,D,F,I,R,S
  2660. KEYCTLR  EQU   KEYPGUP    CTL-R PAGE UP
  2661. KEYCTLS  EQU   KEYLEFT    CTL-S CURSOR LEFT
  2662. KEYCTLU  EQU   KEYINS     CTL-U INSERT
  2663. KEYCTLX  EQU   KEYDOWN    CTL-X CURSOR DOWN
  2664. KEYCTLY  EQU   KEYSHF6    CTL-Y DELETE LINE
  2665. *
  2666. *  KEY ROUTINE TRANSLATE TABLE WITH INDEX TO KRTAB
  2667. *
  2668. KEYTAB   DC    32AL1(KEYUND-KRTAB)  DEFAULT UNDEFINED   0-31
  2669.     DC    96AL1(KEYCHAR-KRTAB) DEFAULT CHAR       32-127
  2670.     DC    128AL1(KEYUND-KRTAB) DEFAULT UNDEFINED 128-255
  2671. *
  2672. *  OVERLAY DEFAULT INDEX VALUES WITH SPECIFIC KEY ROUTINE INDEXES
  2673. *  (SEE MASIC MANUAL APPENDIX G-7 FOR OFFSETS)
  2674. *
  2675.     ORG   KEYTAB+X'03'
  2676.     DC    AL1(KEYCTLC-KRTAB)   CTL-C PAGE DOWN
  2677.     DC    AL1(KEYCTLD-KRTAB)   CTL-D CURSOR RIGHT
  2678.     DC    AL1(KEYCTLE-KRTAB)   CTL-E CURSOR UP
  2679.     ORG   KEYTAB+X'07'
  2680.     DC    AL1(KEYCTLG-KRTAB)   CTL-G DELETE
  2681.     DC    AL1(KEYBS-KRTAB)     CTL-H BACK SPACE
  2682.     DC    AL1(KEYHT-KRTAB)     CTL-I HORIZONTAL TAB
  2683.     ORG   KEYTAB+X'0B'
  2684.     DC    AL1(KEYCTLK-KRTAB)   CTL-K ROUTE B,C,D,K,Q,Y
  2685.     DC    AL1(KEYCTLL-KRTAB)   CTL-L REPEAT LAST SEARCH
  2686.     DC    AL1(KEYCR-KRTAB)     CARRIAGE RETURN (ENTER)
  2687.     DC    AL1(KEYCTLN-KRTAB)   CTL-N INSERT LINE
  2688.     ORG   KEYTAB+X'11'
  2689.     DC    AL1(KEYCTLQ-KRTAB)   CTL-Q ROUTE A,C,D,F,I,R,S
  2690.     DC    AL1(KEYCTLR-KRTAB)   CTL-R PAGE UP
  2691.     DC    AL1(KEYCTLS-KRTAB)   CTL-S CURSOR LEFT
  2692.     ORG   KEYTAB+X'15'
  2693.     DC    AL1(KEYCTLU-KRTAB)   CTL-U INSERT
  2694.     ORG   KEYTAB+X'18'
  2695.     DC    AL1(KEYCTLX-KRTAB)   CTL-X DOWN
  2696.     DC    AL1(KEYCTLY-KRTAB)   CTL-Y DELETE LINE
  2697.     ORG   KEYTAB+X'1B'
  2698.     DC    AL1(KEYESC-KRTAB)    ESCAPE KEY
  2699.     ORG   KEYTAB+128+59
  2700.     DC    AL1(KEYF1-KRTAB)     F1 HELP SCREEN 1
  2701.     DC    AL1(KEYF2-KRTAB)     F2 HELP SCREEN 2
  2702.     DC    AL1(KEYF3-KRTAB)     F3 START OF LINE
  2703.     DC    AL1(KEYF4-KRTAB)     F4 END OF LINE
  2704.     DC    AL1(KEYF5-KRTAB)     F5 LABEL BLOCK OF LINES
  2705.     DC    AL1(KEYF6-KRTAB)     F6 DUPLICATE BLOCK OF LINES
  2706.     DC    AL1(KEYF7-KRTAB)     F7 SEARCH
  2707.     DC    AL1(KEYF8-KRTAB)     F8 REPEAT SEARCH
  2708.     DC    AL1(KEYF9-KRTAB)     F9 COLOR SELECTION
  2709.     DC    AL1(KEYF10-KRTAB)    F10 DISPLAY FREE MEMORY
  2710.     ORG   KEYTAB+128+71
  2711.     DC    AL1(KEYHOME-KRTAB)   HOME
  2712.     ORG   KEYTAB+128+72
  2713.     DC    AL1(KEYUP-KRTAB)     CURSOR UP
  2714.     ORG   KEYTAB+128+73
  2715.     DC    AL1(KEYPGUP-KRTAB)   PAGE UP
  2716.     ORG   KEYTAB+128+75
  2717.     DC    AL1(KEYLEFT-KRTAB)   CURSOR LEFT
  2718.     ORG   KEYTAB+128+77
  2719.     DC    AL1(KEYRIGHT-KRTAB)  CURSOR RIGHT
  2720.     ORG   KEYTAB+128+79
  2721.     DC    AL1(KEYEND-KRTAB)    END
  2722.     ORG   KEYTAB+128+80
  2723.     DC    AL1(KEYDOWN-KRTAB)   CURSOR DOWN
  2724.     ORG   KEYTAB+128+81
  2725.     DC    AL1(KEYPGDN-KRTAB)   PAGE DOWN
  2726.     ORG   KEYTAB+128+82
  2727.     DC    AL1(KEYINS-KRTAB)    INSERT
  2728.     ORG   KEYTAB+128+83
  2729.     DC    AL1(KEYDEL-KRTAB)    DELETE
  2730.     ORG   KEYTAB+128+84
  2731.     DC    AL1(KEYSHF1-KRTAB)   SHFT-F1 QUICK SAVE
  2732.     ORG   KEYTAB+128+86
  2733.     DC    AL1(KEYSHF3-KRTAB)   SHFT-F3 START OF LINE
  2734.     ORG   KEYTAB+128+87
  2735.     DC    AL1(KEYSHF4-KRTAB)   SHFT-F4 END OF LINE
  2736.     ORG   KEYTAB+128+89
  2737.     DC    AL1(KEYSHF6-KRTAB)   SHFT-F6 DELETE LINE
  2738.     ORG   KEYTAB+128+90
  2739.     DC    AL1(KEYSHF7-KRTAB)   SHFT-F7 SET AUTO TAB (INDENT)
  2740.     ORG   KEYTAB+128+92
  2741.     DC    AL1(KEYSHF9-KRTAB)   SHFT-F9 SET AUTO TAB (INDENT)
  2742.     ORG   KEYTAB+128+93
  2743.     DC    AL1(KEYSHF10-KRTAB)  SHFT-F10 CHANGE BOX GRAPHIC SET
  2744.     ORG   KEYTAB+128+104
  2745.     DC    AL1(KEYALTF1-KRTAB)  ALT-F1   PAUSE UNTIL KEY HIT
  2746.     ORG   KEYTAB+128+105
  2747.     DC    AL1(KEYALTF2-KRTAB)  ALT-F2   WAIT ONE SECOND
  2748.     ORG   KEYTAB+128+106
  2749.     DC    AL1(KEYALTF3-KRTAB)  ALT-F3   ENTER DEBUG MODE
  2750.     ORG   KEYTAB+128+107
  2751.     DC    AL1(KEYALTF4-KRTAB)  ALT-F4   TOGGLE AUDIT MODE
  2752.     ORG   KEYTAB+128+108
  2753.     DC    AL1(KEYALTF5-KRTAB)  ALT-F5   GO TO LINE #
  2754.     ORG   KEYTAB+128+113
  2755.     DC    AL1(KEYALTFA-KRTAB)  ALT-F10  TOGGLE BOX CONNECT MODE
  2756. *
  2757. *  END OF KEYTAB
  2758. *
  2759.     ORG   KEYTAB+256
  2760. ATTRIB   DC    X'17'        WHITE ON BLUE DEFAULT SCREEN
  2761. ATTSAVE  DC    X'00'        SAVE DURING REVERSE VIDEO MARKING
  2762. * SEE TECH. HANDBOOK 1-140 FOR COLOR ATTIRBUTES ON IBM COLOR MONITOR
  2763. * USE X'0E' FOR TURBO PASCAL DEFAULT YELLOW ON BLACK
  2764. SAVEAREA DC    9D'0'
  2765. INITSV14 DC    A(0)    SAVE LINK FOR INIT
  2766. HELPSV14 DC    A(0)    SAVE LINK FOR HELPSCRN
  2767. TERMSV14 DC    A(0)    SAVE LINK FOR TERMKS
  2768. LOADSV14 DC    A(0)    SAVE LINK FOR LOADFILE
  2769. EDITSV14 DC    A(0)    SAVE LINK FOR EDITFILE
  2770. SAVESV14 DC    A(0)    SAVE LINK FOR SAVEFILE
  2771. DISPSV14 DC    A(0)    SAVE LINK FOR DISPLAY
  2772. SETCSV14 DC    A(0)    SAVE LINK FOR SETCUR
  2773. CLRSV14  DC    A(0)    SAVE LINK FOR CLEAR
  2774. CLRLSV14 DC    A(0)    SAVE LINK FOR CLRLINE
  2775. GETKSV14 DC    A(0)    SAVE LINK FOR GETKEY
  2776. PUTLSV14 DC    A(0)    SAVE LINK FOR PUTLINE
  2777. PUTSSV14 DC    A(0)    SAVE LINK FOR PUTSTAT
  2778. CHKMSV14 DC    A(0)    SAVE LINK FOR CHKMARK
  2779. NEWFSV14 DC    A(0)    SAVE LINK FOR NEWFILE
  2780. UPDTSV14 DC    A(0)    SAVE LINK FOR UPDATE
  2781. SCRLSV14 DC    A(0)    SAVE LINK FOR SCRLDOWN, SCRLUP
  2782. KRCRSV14 DC    A(0)    SAVE LINK FOR KRCR
  2783. INSCSV14 DC    A(0)    SAVE LINK FOR KRINSCOM
  2784. KEYSSV14 DC    A(0)    SAVE LINK FOR KEYSTATS
  2785. PPCTSV14 DC    A(0)    SAVE LINK FOR PUTPCT
  2786. KR10SV14 DC    A(0)    SAVE LINK FOR KRF10
  2787. KRBXSV14 DC    A(0)    SAVE LINK FOR KRCHKBOX
  2788. SCHRSV14 DC    A(0)    SAVE LINK FOR KRSETCHR
  2789. GETWSV14 DC    A(0)    SAVE LINK FOR GETWORD
  2790. GETMSV14 DC    A(0)    SAVE LINK FOR GETNEWLB
  2791. KRWTSV14 DC    A(0)    SAVE LINK FOR KRALTF1/F2
  2792. KRSV14   DC    A(0)    COMMON SAVE FOR FIRST LEVEL KR ROUTINES
  2793. SAVER0R3 DS    4F      SAVE AREA FOR AUDIT ROUTINES (REQ'D FOR SEARCH)
  2794. KRF9SV12 DS    2F      SAVE AREA FOR F9
  2795. GETWSV34 DS    2F      SAVE AREA FOR GETWORD ACROSS GETKEY
  2796. TRUE     EQU   1
  2797. FALSE    EQU   0
  2798. MARK     EQU   2       MARKING BLK LABEL MODE
  2799.     DC    C'*** AUDIT ***'
  2800. ALC      DC    AL1(TRUE)   FILE TYPE ALC (USED FOR TAB PROCESSING)
  2801. AUDIT    DC    AL1(FALSE)  AUDIT SWITCH FOR AUDITSCB AND AUDITMS
  2802. HTMODE   DC    AL1(FALSE)  AUTO TAB MODE
  2803. EOF1     DC    AL1(FALSE)  END OF FILE
  2804. EOJ      DC    AL1(FALSE)  END OF JOB
  2805. FILEMOD  DC    AL1(FALSE)  FILE MODIFIED
  2806. SCRMOD   DC    AL1(FALSE)  SCREEN MODIFIED
  2807. BLKLABEL DC    AL1(FALSE)  LABELED BLOCK  (TRI-STATE FALSE,MARK,TRUE)
  2808. SAVBLKLB DC    AL1(FALSE)  SAVE LABELD BLK MODE DURING DISPLAY
  2809. CURDEL   DC    AL1(FALSE)  CURRENT LB DELETED
  2810. FIRSTSAV DC    AL1(TRUE)   FIRST SAVE REQUEST
  2811. REPLACE  DC    AL1(FALSE)  SEARCH AND REPLACE
  2812. GLOBAL   DC    AL1(FALSE)  GLOBAL REPLACE
  2813. BOX      DC    AL1(FALSE)  BOX CHARACTER GRPAHICS MODE
  2814. CONNECT  DC    AL1(FALSE)  BOX GRAPHIC CONNECT MODE
  2815. DIRUP    EQU   0
  2816. DIRRIGHT EQU   1
  2817. DIRDOWN  EQU   2
  2818. DIRLEFT  EQU   3
  2819. DIRLAST  DC    AL1(DIRRIGHT)
  2820. DIRNEW   DC    AL1(DIRRIGHT)
  2821. DIRTAB   DC    AL1(BU,BUR,BD,BUL,BRU,BR,BUL,BL)
  2822.     DC    AL1(BU,BLU,BD,BRU,BLU,BR,BUR,BL)
  2823. BU       EQU   0 UP
  2824. BD       EQU   1 DOWN
  2825. BUR      EQU   2 UPPER LEFT
  2826. BUL      EQU   3 UPPER RIGHT
  2827. BRU      EQU   4 LOWER RIGHT
  2828. BR       EQU   5 RIGHT
  2829. BL       EQU   6 LEFT
  2830. BLU      EQU   7 LOWER LEFT
  2831. REVDIR   DC    AL1(DIRDOWN,DIRLEFT,DIRUP,DIRRIGHT)  REVERSE OF DIRECTION
  2832. REVLAST  DC    AL1(0)                               SAVE REV OF DIRLAST
  2833. BOXSET   EQU   *
  2834. BOXSET2  DC    AL1(186,186,201,187,188,205,205,200)  GRAPHIC DOUBLE LINE BOX
  2835. BOXSET1  DC    AL1(179,179,218,191,217,196,196,192)  GRAPHIC SINGLE LINE BOX
  2836.     DC    8AL1(ASCASK)                          ASCII * PRINTABLE BOX
  2837.     DC    AL1(94,118,88,88,88,62,60,88)         ARROWS (SORT OF)
  2838.     DC    8AL1(ASCBLK)                          BLANK (FOR BG COLORS)
  2839. BOXSETE  EQU   *
  2840. BOXSETA  DC    A(BOXSET)   ADDRESS OF CURRENT BOX SET
  2841. BOXCON   EQU   *           TABLE TO CONNECT SINGLE/DOUBLE BOX LINES
  2842. *
  2843. * SEE IBM TECH. REF. FOR PC PAGES C-7 THRU C-9 FOR GRAPHICS 179-218
  2844. *
  2845. *                  ---- SINGLE --- ---- DOUBLE ---
  2846. *                   UP  RT  DN  LF  UP  RT  DN  LF
  2847. *
  2848.     DC    AL1(179,195,179,180,186,198,186,181) 179
  2849.     DC    AL1(180,197,180,180,180,180,180,181) 180
  2850.     DC    AL1(181,181,181,180,181,216,181,181) 181
  2851.     DC    AL1(182,215,182,182,182,182,182,185) 182
  2852.     DC    AL1(183,210,191,183,182,183,183,187) 183
  2853.     DC    AL1(181,184,184,191,184,209,187,184) 184
  2854.     DC    AL1(185,185,185,182,185,206,185,185) 185
  2855.     DC    AL1(179,199,179,182,186,204,186,185) 186
  2856.     DC    AL1(187,187,184,183,185,203,187,187) 187
  2857.     DC    AL1(190,188,188,189,188,202,185,188) 188
  2858.     DC    AL1(217,208,189,189,189,189,182,188) 189
  2859.     DC    AL1(190,190,181,217,188,207,190,190) 190
  2860.     DC    AL1(180,194,191,191,191,191,183,184) 191
  2861.     DC    AL1(192,192,195,193,211,212,192,192) 192
  2862.     DC    AL1(193,193,197,193,208,193,193,193) 193
  2863.     DC    AL1(197,194,194,194,194,194,210,194) 194
  2864.     DC    AL1(195,195,195,197,195,198,195,195) 195
  2865.     DC    AL1(193,196,194,196,208,205,210,205) 196
  2866.     DC    AL1(197,197,197,197,197,197,197,197) 197
  2867.     DC    AL1(198,195,198,198,198,198,198,216) 198
  2868.     DC    AL1(199,199,199,215,199,204,199,199) 199
  2869.     DC    AL1(212,211,200,200,200,200,204,202) 200
  2870.     DC    AL1(201,214,213,201,204,201,201,203) 201
  2871.     DC    AL1(207,202,202,202,202,202,206,202) 202
  2872.     DC    AL1(203,203,209,203,206,203,203,203) 203
  2873.     DC    AL1(204,199,204,204,204,204,204,206) 204
  2874.     DC    AL1(207,196,209,196,202,205,203,205) 205
  2875.     DC    AL1(206,206,206,206,206,206,206,206) 206
  2876.     DC    AL1(207,207,216,207,202,207,207,207) 207
  2877.     DC    AL1(193,208,208,208,208,208,215,208) 208
  2878.     DC    AL1(216,209,209,209,209,209,203,209) 209
  2879.     DC    AL1(210,210,194,210,215,210,210,210) 210
  2880.     DC    AL1(192,211,211,208,211,200,209,211) 211
  2881.     DC    AL1(212,192,198,212,200,212,212,207) 212
  2882.     DC    AL1(198,218,213,213,213,213,201,209) 213
  2883.     DC    AL1(214,214,218,210,209,201,214,214) 214
  2884.     DC    AL1(215,215,215,215,215,215,215,215) 215
  2885.     DC    AL1(216,216,216,216,216,216,216,216) 216
  2886.     DC    AL1(217,193,180,217,189,217,217,190) 217
  2887.     DC    AL1(195,218,218,194,218,213,214,218) 218
  2888. SCRLEND  EQU   23*256+79   SCROLL ENDING ROW AND COL
  2889. SAVETYPE DC    CL3' '      SAVE ORIG. FILE TYPE
  2890. ROWINC   EQU   256         INCREMENT FOR ROW IN R5 REG. (3RD BYTE)
  2891. MAXROW   DC    A(23*ROWINC)   LAST ROW ON SCREEN
  2892. MAXSCB   DC    A(0)           LAST ROW SCB POINTER
  2893. LASTROW  DC    A(0)        LAST ROW CURSOR
  2894. LASTSCB  DC    A(0)        LAST SCB ADDR
  2895. SAVEROW  DC    A(0)        TEMP SAVE FOR ROW (R5)
  2896. SAVECOL  DC    A(0)        TEMP SAVE FOR COL (R6)
  2897. SAVESCB  DC    A(0)        TEMP SAVE FOR SCB (R7)
  2898. BLK1LB   DC    A(0)        STARTING LB OF BLOCK
  2899. BLK2LB   DC    A(0)        ENDING   LB OF BLOCK
  2900. NEXTBLK  DC    A(0)        NEXT LB TO DUPLICATE
  2901. SAVENEXT DC    A(0)        SAVE NEXT LB FROM CURRENT LB
  2902. PREVDUP  DC    A(0)        PREVIOUS LB IN DUPLICATE CHAIN
  2903. PTOTAL   DC    PL3'0'
  2904. LOADMSG  DC    C' LINES LOADED ='
  2905. DTOTAL   DC    CL6' ZZZZZ',C'$'
  2906. LBUFF1   EQU   8192
  2907. LBUFF2   EQU   4096
  2908. LBUFFS   EQU   LBUFF1+LBUFF2
  2909. TBUFF    EQU   X'80'       COMMAND LINE IN LOW MEMORY
  2910. ATYPE1   DC    A(DSN1+4)   DEFAULT ADDR OF .XXX IN DSN
  2911. DSN1     DC    C'TEST.ALC',64X'00'  DSN FROM COMMAND
  2912. REN1     DC    C'TEST.BKP',64X'00'  RENAME DSN FOR SAVE
  2913. SYSUT1   DS    0D          DCB FOR ASCII TEXT FILE READ/WRITE
  2914.     DC    C'ADCB'
  2915.     DC    A(DSN1) ADDRESS OF UP TO 64 BYTE PATH/FILE
  2916.     DC    X'FFFF' HANDLE ASSIGNED BY MS-DOS AT OPEN
  2917.     DC    X'00'   DATA CONTROL BLOCK FLAGS
  2918.     DC    C'S'    DATA SET ORGANIZATION
  2919.     DC    C'G'    DATA SET ACCESS MODE
  2920.     DC    C'T'    DATA SET RECORD FORMAT
  2921.     DC    X'0A'   END OF RECORD CODE
  2922.     DC    X'1A'   END OF FILE CODE
  2923.     DC    H'135'  RECORD LENGTH
  2924.     DC    AL2(LBUFF1) BLOCK  LENGTH (2<BLKSZ<64K-16)
  2925.     DC    A(EOFUT1)  END OF DATA EXIT ADDRESS
  2926.     DC    A(E01)     SYCHRONOUS ERROR EXIT ADDRESS
  2927.     DC    A(WLBLINE) RECORD AREA ADDRESS FOR GET/PUT
  2928.     DC    A(0)       BLOCK  AREA ADDRESS (0 FOR DYNAM)
  2929.     DC    A(0)       RELATIVE BYTE ADDRESS
  2930.     DC    A(REN1)    RENAME ASCIIZ FILE
  2931.     DC    F'0'       BLOCK I/O COUNT SINCE OPEN
  2932.     DC    H'0'       PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  2933. *
  2934. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  2935. *
  2936.     DC    XL4'00' SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  2937.     DC    XL4'00' SEGMENT:OFFSET OF EODAD EXIT
  2938.     DC    XL4'00' SEGMENT:OFFSET OF SYNAD EXIT
  2939.     DC    XL4'00' SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  2940.     DC    XL4'00' SEGMENT:OFFSET OF RENAME FILE NAME
  2941.     DC    XL4'00' SEGMENT:OFFSET OF BLOCK AREA
  2942.     DC    XL4'00' SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  2943.     DC    XL2'00' OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  2944.     DC    XL2'00' OFFSET OF END OF ALLOCATED BLOCK AREA
  2945.     DC    H'0'    REVERSED LRECL
  2946.     DC    H'0'    REVERSED BLKSZ
  2947. *
  2948. * DATA FOR KEYBOARD SIMULATOR
  2949. *
  2950. KSOFF    EQU   0
  2951. KSREAD   EQU   1
  2952. KSWRITE  EQU   2
  2953.     DC    C'**** KSREC ****'
  2954. KSREC    DC    XL256'00'
  2955. KSRECEND EQU   *
  2956.     DC    C'**** KSNEXT ****'
  2957. KSNEXT   DC    A(KSRECEND)  ASSUME READ AND SET TO FORCE NEXT READ
  2958. KSMODE   DC    AL1(KSOFF)
  2959. DSN2     DC    C'TEST.KSF',64X'00'  DSN FROM COMMAND LINE
  2960. SYSUT2   DS    0D      DCB FOR KEYBOARD SIMULATOR
  2961.     DC    C'ADCB'
  2962.     DC    A(DSN2) ADDRESS OF UP TO 64 BYTE PATH/FILE
  2963.     DC    X'FFFF' HANDLE ASSIGNED BY MS-DOS AT OPEN
  2964.     DC    X'00'   DATA CONTROL BLOCK FLAGS
  2965.     DC    C'S'    DATA SET ORGANIZATION
  2966.     DC    C'G'    DATA SET ACCESS MODE
  2967.     DC    C'F'    DATA SET RECORD FORMAT
  2968.     DC    X'0A'   END OF RECORD CODE
  2969.     DC    X'1A'   END OF FILE CODE
  2970.     DC    H'256'  RECORD LENGTH
  2971.     DC    AL2(LBUFF2) BLOCK  LENGTH (2<BLKSZ<64K-16)
  2972.     DC    A(EOFUT2)  END OF DATA EXIT ADDRESS
  2973.     DC    A(E01)     SYCHRONOUS ERROR EXIT ADDRESS
  2974.     DC    A(KSREC)   RECORD AREA ADDRESS FOR GET/PUT
  2975.     DC    A(0)       BLOCK  AREA ADDRESS (0 FOR DYNAM)
  2976.     DC    A(0)       RELATIVE BYTE ADDRESS
  2977.     DC    A(0)       RENAME ASCIIZ FILE
  2978.     DC    F'0'       BLOCK I/O COUNT SINCE OPEN
  2979.     DC    H'0'       PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  2980. *
  2981. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  2982. *
  2983.     DC    XL4'00' SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  2984.     DC    XL4'00' SEGMENT:OFFSET OF EODAD EXIT
  2985.     DC    XL4'00' SEGMENT:OFFSET OF SYNAD EXIT
  2986.     DC    XL4'00' SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  2987.     DC    XL4'00' SEGMENT:OFFSET OF RENAME FILE NAME
  2988.     DC    XL4'00' SEGMENT:OFFSET OF BLOCK AREA
  2989.     DC    XL4'00' SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  2990.     DC    XL2'00' OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  2991.     DC    XL2'00' OFFSET OF END OF ALLOCATED BLOCK AREA
  2992.     DC    H'0'    REVERSED LRECL
  2993.     DC    H'0'    REVERSED BLKSZ
  2994. *
  2995. *  DATA FOR LINE BLOCKS
  2996. *
  2997.     DC    C'*** FIRST/LAST/CUR ***'
  2998. GLBFIRST DC    A(0) GLOBAL POINTER TO FIRST LB
  2999. GLBLAST  DC    A(0) GLOBAL POINTER TO LAST  LB
  3000. GLBCUR   DC    A(0) GLOBAL POINTER TO CURRENT LB
  3001.     DC    C'*** GFQEA/L ***'
  3002. GFQEA    DC    A(0) ADDRESS OF REMAINING FREE EXTENDED MEMORY
  3003. GFQEL    DC    F'0' LENGTH OF REMAINING FREE EXTENDED MEMORY
  3004. MINMEM   DC    A(0) LOW LIMIT
  3005. MAXMEM   DC    A(0) MAX LIMIT
  3006. ANEWLB   DC    A(0) LB ALLOCATED BY GETNEWLB
  3007. AFREELB  DC    A(0) QUEUE OF FREE LB'S CREATED BY DELETE
  3008. WLBADDR  DS    A
  3009. WLB      DS    0X
  3010. WLBPREV  DC    A(0)
  3011. WLBNEXT  DC    A(0)
  3012. WLBLINE  DC    CL80' ',CL53' ' PAD TO 133 FOR READING PRINT FILES
  3013.     DC    AL1(ASCCR,ASCLF)
  3014. TLBADDR  DS    A
  3015. TLB      DS    0X
  3016. TLBPREV  DS    A
  3017. TLBNEXT  DS    A
  3018. TLBLINE  DS    CL80,CL53
  3019. STATRC0  EQU   24*256
  3020. STATROW  DC    A(STATRC0)
  3021. STATLINE DS    0CL80
  3022. STATMSG  DC    CL20'LOADING FILE ',C' '
  3023. STATNAME DC    CL15' ',C' LINE'
  3024. STATREC  DC    CL6' ',C'  COL'
  3025. STATCOL  DC    CL4' ',C'  '
  3026. STATCAP  DC    CL3' ',C' '  CAPS KEY ON/OFF
  3027. STATINS  DC    CL3' ',C' '  INSERT MODE ON/OFF
  3028. STATNUM  DC    CL3' ',C' '  NUM KEY ON/OFF
  3029. STATBLK  DC    CL3' ',C' '  LABELED BLOCK ON/OFF (F5, CTL-K B/K)
  3030. STATPCT  DC    CL4' ',C'%'
  3031.     DC    (STATLINE+80-*)C' '
  3032.     DC    X'00'  EOR FOR PRINTTXT
  3033. KBCAP    DC    X'00'  CAPS KEY STATUS VIA BIOS KEYBOARD
  3034. KBINS    DC    X'00'  INS  KEY STATUS VIA BIOS KEYBOARD (SEE NOTES)
  3035. KBNUM    DC    X'00'  NUM  KEY STATUS VIA BIOS KEYBOARD
  3036. KBCAPLST DC    X'00'
  3037. KBINSLST DC    X'00'
  3038. KBNUMLST DC    X'00'
  3039. INSSTATE EQU   X'80' INSERT KEY ON (TECH. A-3)
  3040. CAPSTATE EQU   X'40' CAPS   KEY ON
  3041. NUMSTATE EQU   X'20' NUM    KEY ON
  3042. PBLKCNT  DC    PL3'0' RECORDS IN BLOCK
  3043. PCURBLK1 DC    PL3'0' RECORD # OF FIRST BLOCK RECORD
  3044. PCUR     DC    PL3'1' CURRENT RECORD # FOR ROW 0
  3045. PCURLINE DC    PL3'1' CURRENT RECORD # FOR CURSOR ROW
  3046. PCURSRCH DC    PL3'0' CURRENT RECORD # FOR SEARCH
  3047. PLSTLINE DC    PL3'0' LAST RECORD #
  3048. PCHKLINE DC    PL3'0' AUDIT LAST RECORD #
  3049. PCOL     DC    PL2'0' CURRENT COL
  3050. PCURLAST DC    PL3'0' LAST REC UPDATE BY SETCUR
  3051. PCOLLAST DC    PL2'0' LAST COL UPDATE BY SETCUR
  3052. FMAXLINE DC    F'0'   MAXIMUM LINES POSSIBLE IN MS
  3053. PWORK    DC    D'0'   PACKED DECIMAL WORK AREA
  3054. PWORK1   DC    D'0'
  3055.     DC    C'*** ASCB ***'
  3056. ASCB     DC    A(0) ADDRESS OF SCREEN CONTROL BLOCK
  3057. F1SC     EQU   *
  3058.     DC    CL80'SEE Screen Editor and Emulator R2.0 05/22/87'
  3059.     DC    CL80' '
  3060.     DC    CL80'Copyright (c) 1987 Donald S. Higgins'
  3061.     DC    CL80' '
  3062.     DC    CL80'Type F1 for this screen; F2 for keystroke help.'
  3063.     DC    CL80'For additional documentation, SEE PC370.DOC.'
  3064.     DC    CL80' '
  3065.     DC    CL80'SEE is a full screen color text editor distributed'
  3066.     DC    CL80'in source and object form with the PC/370 freeware'
  3067.     DC    CL80'370 cross assembler, linkage editor, and emulator'
  3068.     DC    CL80'package.  You are encouraged to copy and share'
  3069.     DC    CL80'this program provided this copyright message is'
  3070.     DC    CL80'not removed or modified and no fee is charged.'
  3071.     DC    CL80'If you find PC/370 of value, support continued'
  3072.     DC    CL80'freeware updates by sending 45 dollars to:'
  3073.     DC    CL80' '
  3074.     DC    CL80'         Don Higgins'
  3075.     DC    CL80'         6365 - 32 Avenue North'
  3076.     DC    CL80'         St. Petersburg, Florida 33710'
  3077. F1SCEND  EQU    *
  3078. F2SC     EQU   *
  3079. *                   0        1         2         3         4
  3080. *                   1        0         0         0         0
  3081.     DC    CL40'KEY     ALTERNATE   DESCRIPTION         '  1
  3082.     DC    CL40'KEY     ALTERNATE   DESCRIPTION         '
  3083.     DC    CL80' '                                         2
  3084.     DC    CL40'Esc     ctl-K D     save file and exit  '  3
  3085.     DC    CL40'PgUp    ctl-R       page up half        '
  3086.     DC    CL40'PgDn    ctl-C       page down half      '  4
  3087.     DC    CL40'arrows  ctl-S/D/E/X move cursor         '
  3088.     DC    CL40'home    ctl-Q R     go to top of file   '  5
  3089.     DC    CL40'End     ctl-Q C     go to end of file   '
  3090.     DC    CL40'Ins     ctl-U       set/reset insert    '  6
  3091.     DC    CL40'Del     ctl-G/K Y   delete char/block   '
  3092.     DC    CL40'Tab     ctl-I       tab to next column  '  7
  3093.     DC    CL40'Bs      ctl-H       backspace           '
  3094.     DC    CL40'Enter   ctl-N       next/insert line    '  8
  3095.     DC    CL40'F1/F2               help screen 1/2     '
  3096.     DC    CL40'F3/F4   ctl-Q S/D   start/end line      '  9
  3097.     DC    CL40'F5/F6   ctl-K B/K/C label/dup. block    '
  3098.     DC    CL40'F7      ctl-Q F/A   search/replace str. ' 10
  3099.     DC    CL40'F8      ctl-L       repeat search/repl. '
  3100.     DC    CL40'F9                  set color           ' 11
  3101.     DC    CL40'F10                 set/reset box graph '
  3102.     DC    CL40'Shft-F1             quick save file     ' 12
  3103.     DC    CL40'Shft-F6 ctl-Y       delete line         '
  3104.     DC    CL40'Shft-F9 ctl-Q I     set/reset auto tab  ' 13
  3105.     DC    CL40'Shft-F10            change box graph set'
  3106.     DC    CL40'Ctl-brk ctl-K Q     force exit no save  ' 14
  3107.     DC    CL40'Alt-F1              pause until key hit '
  3108.     DC    CL40'Alt-F2              wait for 1 second   ' 15
  3109.     DC    CL40'Alt-F3              enter debug mode    '
  3110.     DC    CL40'Alt-F4              toggle audit mode   ' 16
  3111.     DC    CL40'Alt-F5              go to line #        '
  3112.     DC    CL40'Alt-F10             toggle box connect  ' 17
  3113.     DC    CL40' '
  3114.     DC    CL80' '
  3115.     DC    CL80'Note F9 color selection is changed by entering'
  3116.     DC    CL80'hex digits or using arrows to select digit and'
  3117.     DC    CL80'change colors.  Press enter to continue.'
  3118.     DC    CL80'Note F10, shift-F10, and alt-F10 control box'
  3119.     DC    CL80'graphic mode, characters, and connect options.'
  3120. F2SCEND EQU    *
  3121. *
  3122. * DSECTS
  3123. *
  3124. *
  3125. *  LINE BLOCK FOR STORING TEXT IN EXTENDED MEMORY
  3126. *
  3127. LB       DSECT
  3128. LBPREV   DS    A      ADDRESS OF PREVIOUS LB
  3129. LBNEXT   DS    A      ADDRESS OF NEXT LB
  3130. LBLINE   DS    CL80   TEXT
  3131. LLB      EQU   *-LB
  3132. *
  3133. *  SCREEN CONTROL BLOCK
  3134. *
  3135. SCB      DSECT
  3136. SCBADDR  DS    A      ADDRESS OF LB IN EXTENDED STORAGE
  3137. SCBLB    DS    0XL(LLB)   LB WITHIN SCB
  3138. SCBPREV  DS    A      ADDRESS OF PREV LB
  3139. SCBNEXT  DS    A      ADDRESS OF NEXT LB
  3140. SCBLINE  DS    CL80   LINE OF TEXT
  3141.     DS    XL2    PAD FOR CR,NL FOR FULL LINE OF TEXT
  3142. SCBCOL   DS    X      COL CONTAINING CR/LF (END OF TEXT + 1)
  3143. SCBMOD   DS    X      SET TRUE IF MODIFIED
  3144. LSCB     EQU   *-SCB
  3145. ****************************************************************************
  3146. *
  3147. * IHADCB - I HAD A DCB DSECT FOR PC/370 RELEASE 2.0+ FILE DATA CONTROL BLOCK
  3148. *
  3149. * FOR MORE INFORMATION SEE SVC.DOC AND DEMO PROGRAM TESTIO.ALC.
  3150. *
  3151. ****************************************************************************
  3152. IHADCB   DSECT
  3153. DCBDCB   DS    CL4 CONSTANT EBCDIC C'ADCB' DCB IDENTIFIER
  3154. DCBDSN   DS    A   ADDRESS OF UP TO 64 BYTE PATH/FILE SPEC FOLLOWED BY ZERO
  3155. DCBFID   DS    H   FILE HANDLE ASSIGNED BY MS-DOS AT OPEN (X'FFFF'DEFAULT)
  3156. DCBFLG   DS    X   DATA CONTROL BLOCK FLAGS (ONLY DFTRAN MAY BE SET BY USER)
  3157. DFOPEN   EQU   X'80' FILE OPEN
  3158. DFUBUF   EQU   X'40' USER DEFINED BLOCK AREA (NO DYNAMIC ALLOC/DEALLOC)
  3159. DFOUT    EQU   X'20' OPEN FOR OUTPUT
  3160. DFGEOF   EQU   X'10' END OF FILE PENDING ON SHORT BLOCK
  3161. DFTRAN   EQU   X'08' TRANSLATE GET/PUT RECORDS FOR ASCII FILE
  3162. DFADCB   EQU   X'01' ASSIST DCB - DO NOT TRANSLATE 370 ADDRESSES
  3163. DSORG    DS    C   DATA SET ORGANIZATION (R=RANDOM, S=SEQUENTIAL)
  3164. MACRF    DS    C   DATA SET ACCESS MODE (R=READ, W=WRITE, G=GET, P=PUT)
  3165. RECFM    DS    C   DATA SET RECORD FORMAT (F=FIXED, V=VAR, T=TEXT)
  3166. EOR      DS    X   END OF RECORD CODE (DEFAULT IS LINE FEED X'0A')
  3167. EOF      DS    X   END OF FILE CODE   (DEFAULT IS CTL-Z X'1A')
  3168. LRECL    DS    H   RECORD LENGTH (2<LRECL<64K-16)
  3169. BLKSZ    DS    H   BLOCK  LENGTH (2<BLKSZ<64K-16)
  3170. EODAD    DS    A   END OF DATA EXIT ADDRESS
  3171. SYNAD    DS    A   SYCHRONOUS ERROR EXIT ADDRESS
  3172. RCD      DS    A   RECORD AREA ADDRESS FOR GET/PUT
  3173. BLK      DS    A   BLOCK  AREA ADDRESS (0 FOR DYNAMICALLY ALLOCATED)
  3174. RBA      DS    A   RELATIVE BYTE ADDRESS FOR RANDOM READ/WRITE
  3175. REN      DS    A   RENAME ASCIIZ FILE (ONLY USED BY RENAME SVC)
  3176. IOCNT    DS    F   BLOCK I/O COUNT SINCE OPEN
  3177. PRECL    DS    H   PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  3178. *
  3179. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  3180. *
  3181. DSNSG    DS    XL4 SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  3182. EODSG    DS    XL4 SEGMENT:OFFSET OF EODAD EXIT
  3183. SYNSG    DS    XL4 SEGMENT:OFFSET OF SYNAD EXIT
  3184. RCDSG    DS    XL4 SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  3185. RENSG    DS    XL4 SEGMENT:OFFSET OF RENAME FILE NAME
  3186. BLKSG    DS    XL4 SEGMENT:OFFSET OF BLOCK AREA
  3187. BLKPTR   DS    XL4 SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  3188. BLKEOD   DS    XL2 OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  3189. BLKEND   DS    XL2 OFFSET OF END OF ALLOCATED BLOCK AREA
  3190. WLRECL   DS    H   REVERSED LRECL
  3191. WBLKSZ   DS    H   REVERSED BLKSZ
  3192. LDCB     EQU   *-IHADCB
  3193.     END   SEE
  3194.