home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG023.ARK / STOICEDT.STC < prev    next >
Text File  |  1984-04-29  |  9KB  |  355 lines
  1.  
  2.  
  3. % ***************************************************************************
  4. % ** COPYRIGHT (C) MASSACHUSETTS INSTITUTE OF TECHNOLOGY AND HARVARD       **
  5. % ** UNIVERSITY, BIOMEDICAL ENGINEERING CENTER 1977.  ALL RIGHTS RESERVED. **
  6. % ***************************************************************************
  7.  
  8. % 8080 DISPLAY EDITOR
  9. % J. SACHS 2/9/77
  10.  
  11. RADIX @ OCTAL
  12.  
  13. % DEFINE EDITOR BRANCH
  14. 'EDITOR< BRANCH
  15. EDITOR< DEFINITIONS
  16.  
  17. % EDITOR VARIABLES
  18. 0 'LAST VARIABLE        % PTR TO END OF TEXT BUFFER
  19.                 % (ALSO START OF X BUFFER)
  20. 0 'XLAST VARIABLE        % PTR TO END OF X BUFFER
  21. 0 'CP VARIABLE            % CURSOR
  22. 0 'P1 VARIABLE            % PTR TO START OF CURRENT STRING
  23. 0 'P2 VARIABLE            % PTR TO END OF CURRENT STRING
  24. 0 'P3 VARIABLE            % TEMPORARY
  25. 0 'C1 VARIABLE            % TEMPORARY
  26. 0 'LINE-TERMINATOR VARIABLE    % TERMINATOR FOR GETLINE
  27. 0 'IFLAG VARIABLE        % INPUT FILE ACTIVE FLAG
  28. 0 'OFLAG VARIABLE        % OUTPUT FILE ACTIVE FLAG
  29. 4 'INAME ARRAY            % INPUT FILE NAME
  30. 4 'ONAME ARRAY            % OUTPUT FILE NAME
  31. 33 'ESC VARIABLE        % ESCAPE CHAR FOR I/ COMMAND
  32.  
  33. 400 'MARGIN CONSTANT        % DICTIONARY MARGIN FOR EDITOR MACROS, ETC.
  34. 'LIMIT : . MARGIN + ;        % LOWER MEMORY LIMIT
  35.  
  36. % MOVE CP N LINES
  37. 'L CODE<  B POP,  B A MOV,  A ORA,  IFM,  C ORA,  IFZ,
  38.   .  .  CP LHLD,  XCHG,  LAST LHLD,
  39.   -HL CALL,  D DAD,  H A MOV,  L ORA,  NEXT JZ,  XCHG,
  40.   M A MOV,  H INX,  CP SHLD,  15 CPI,  JNZ,  B DCX,
  41.   B A MOV,  C ORA,  JNZ,  NEXT JMP,
  42.   THEN,  THEN,  B DCX,
  43.   .  .  CP LHLD,  XCHG,  MEMORY LHLD,
  44.   -HL CALL,  D DAD,  H A MOV,  L ORA,  NEXT JZ,  XCHG,
  45.   H DCX,  M A MOV,  CP SHLD,  15 CPI,  JNZ,  B INX,
  46.   B A MOV,  C ORA,  JNZ,  CP LHLD,  H INX,  CP SHLD,
  47.   NEXT JMP,  >
  48.  
  49. % COMPARE TWO ARG STRINGS; BYTE COUNT AT TOP
  50. 'CMPBYTES CODE<  B POP,  D POP,  H POP,  B A MOV,  A ORA,
  51.   0PUSH JM,  C ORA,  0PUSH JZ,  .  D LDAX,  M CMP,
  52.   0PUSH JNZ,  D INX,  H INX,  B DCX,  B A MOV,  C ORA,
  53.   JNZ,  -1PUSH JMP,  >
  54.  
  55. % APPEND AN INPUT LINE TO TEXT BUFFER
  56. . <L "CORE FULL" S,
  57.  
  58. 'GETLINE CODE<
  59.   H POP,  T1 SHLD,
  60.   .  <L
  61.   .  <L
  62.   CP LHLD,  XCHG,  P2 LHLD,  -HL CALL,  D DAD,  IFC,
  63.   (GETBYTE) CALL,
  64.   EOF CPI,  -1PUSH JZ,
  65.   CP LHLD,  A M MOV,  H INX,  CP SHLD,
  66.   LINE-TERMINATOR LHLD,  L CMP,  IFZ,
  67.   L> JMP,
  68.   THEN,  T1 LHLD,  H DCX,  T1 SHLD,
  69.   H A MOV,  L ORA,  L> JNZ,  0PUSH JMP,
  70.   THEN,  L> H LXI,  ERROR JMP,  >
  71.  
  72. % DISPLAY CURSORS
  73. 'DISPLAY-CURSORS CODE<  D POP,  -DE CALL,
  74.   P1 LHLD,  D DAD,  H A MOV,  L ORA,  IFNZ,
  75.   173 A MVI,  D PUSH,  (TTO) CALL,  D POP,  THEN,
  76.   CP LHLD,  D DAD,  H A MOV,  L ORA,  IFNZ,
  77.   176 A MVI,  D PUSH,  (TTO) CALL,  D POP,  THEN,
  78.   P2 LHLD,  D DAD,  H A MOV,  L ORA,  IFNZ,
  79.   175 A MVI,  (TTO) CALL,  THEN,  NEXT JMP, >
  80.  
  81. % DISPLAY A CHARACTER
  82. 'DISPLAY-CHAR CODE<  H POP,  L A MOV,  40 CPI,  IFP,  15 CPI,
  83.   IFZ,  11 CPI,  IFZ,  PSW PUSH,  136 A MVI,  (TTO) CALL,
  84.   PSW POP,  100 ADI,  THEN,  THEN,  THEN,  (TTO) CALL,  NEXT JMP, >
  85.  
  86. % EXCHANGE P1 AND P2 UNLESS P1<P2
  87. 'P1<P2 : P1 @ P2 @ UGT IF P1 P2 XCHG THEN ;
  88.  
  89. % SET P1 TO CP
  90. 'S1 : CP P1 MOVE ;
  91.  
  92. % SET P2 TO CP
  93. 'S2 : CP P2 MOVE ;
  94.  
  95. % SET CP TO BEGINNING OF TEXT BUFFER
  96. 'B : MEMORY CP MOVE ;
  97.  
  98. % SET CP TO END OF TEXT BUFFER
  99. 'Z : LAST  CP MOVE ;
  100.  
  101. % MOVE CP N CHARACTERS
  102. 'M : CP @ + LAST @ MIN MEMORY @ MAX CP ! ;
  103.  
  104. % SET P1, MOVE N CHARACTERS, SET P2
  105. '<M> : S1 M S2 P1<P2 ;
  106.  
  107. % SET P1, MOVE N LINES, SET P2
  108. '<L> : S1 L S2 P1<P2 ;
  109.  
  110. % SET P1 TO FIRST, SET P2 TO LAST
  111. '<ALL> : B S1 Z S2 ;
  112.  
  113. % PUSH THE LINE NUMBER OF THE LINE CONTAINING THE CURSOR
  114. 'LINE# : 0 CP @ MEMORY @ DO I B@ 15 EQ + LOOP MINUS ;
  115.  
  116. % STRING SEARCH
  117. '<S> : C1 ! P3 ! IF
  118.    0 LAST @ C1 @ - CP @ UDO I P3 @ C1 @ CMPBYTES IF -1
  119.    UNDER I P1 ! I C1 @ + DUP P2 ! CP ! EXIT THEN ULOOP
  120.   ELSE
  121.    0 CP @ MEMORY @ UDO I' P3 @ C1 @ CMPBYTES IF -1
  122.    UNDER I' DUP P1 ! CP ! I' C1 @ + P2 ! EXIT THEN ULOOP
  123.   THEN ;
  124.  
  125. '<SS> : SWAP COUNT <S> NOT IF 'MISSING ERR THEN ;
  126. 'S : -1 <SS> ;
  127. 'BS : 0 <SS> ;
  128.  
  129. % DELETE BETWEEN P1 AND P2
  130. '<D> : P1 @ 1- P2 @ 1- P1 @ MEMORY @ - RMVBYTES
  131.    MEMORY @ P1 @ - P2 @ + MEMORY ! P2 P1 MOVE P2 CP MOVE ;
  132.  
  133. % DELETE N CHARACTERS
  134. 'D : <M> <D> ;
  135.  
  136. % DELETE N LINES
  137. 'DL : <L> <D> ;
  138.  
  139. % DELETE TEXT BUFFER
  140. 'DA : <ALL> <D> ;
  141.  
  142. % INSERT STRING
  143. '<I> : C1 ! P3 ! MEMORY @ C1 @ - LIMIT ULE IF "CORE FULL"
  144.   ERR THEN MEMORY @ DUP C1 @ - CP @ MEMORY @ - MVBYTES
  145.   MEMORY @ C1 @ - MEMORY ! P3 @ CP @ C1 @ - C1 @ MVBYTES
  146.   S2 CP @ C1 @ - P1 ! ;
  147.  
  148. % INSERT STRING FOLLOWED BY CR
  149. '<IL> : 1+ <I> 15 P2 @ 1- B! ;
  150.  
  151. % INSERT STRING FOLLOWED BY FF
  152. '<IP> : 1+ <I> 14 P2 @ 1- B! ;
  153.  
  154. 'IS : COUNT <I> ;
  155. 'IL : COUNT <IL> ;
  156. 'IP : COUNT <IP> ;
  157.  
  158. % INSERT CR
  159. 'ICR : '&15& IS ;
  160.  
  161. % INSERT FF
  162. 'IFF : '&14& IS ;
  163.  
  164. % INSERT NUMBER AS TEXT
  165. 'I# : <#> <I> ;
  166.  
  167. % REPLACE CURRENT STRING
  168. 'U : <D> IS ;
  169.  
  170. % STRING SUBSTITUTE
  171. 'C : SWAP S U ;
  172. 'BC : SWAP BS U P1 CP MOVE ;
  173.  
  174. % SEARCH AND DESTROY
  175. 'SD : S <D> ;
  176. 'BSD : BS <D> ;
  177.  
  178. % ADD AN OFFSET TO ALL TEXT BUFFER POINTERS
  179. 'ADJUST : DUP MEMORY +! DUP LAST +! DUP CP +! DUP P1 +! P2 +! ;
  180.  
  181. % DELETE X BUFFER
  182. 'XD : XLAST @ LAST @ -
  183.   LAST @ 1- XLAST @ 1- LAST @ MEMORY @ - RMVBYTES
  184.   ADJUST ;
  185.  
  186. % COPY TEXT BETWEEN P1 AND P2 INTO X BUFFER
  187. '<XC> : XD
  188.   MEMORY @ P2 @ P1 @ - - LIMIT ULE IF "CORE FULL" ERR THEN
  189.   MEMORY @ DUP P2 @ P1 @ - - LAST @ MEMORY @ - MVBYTES
  190.   P1 @ P2 @ - ADJUST P1 @ LAST @ P2 @ P1 @ - MVBYTES ;
  191.  
  192. % COPY N CHARACTERS INTO "X" BUFFER
  193. 'XC : <M> <XC> ;
  194.  
  195. % COPY N LINES INTO "X" BUFFER
  196. 'XCL : <L> <XC> ;
  197.  
  198. % MOVE N CHARACTERS INTO "X" BUFFER
  199. 'XM : XC <D> ;
  200.  
  201. % MOVE N LINES INTO "X" BUFFER
  202. 'XML : XCL <D> ;
  203.  
  204. % INSERT CONTENTS OF "X" BUFFER AT CP
  205. 'XG : LAST @ XLAST @ OVER - <I> ;
  206.  
  207. % OUTPUT TEXT TO OUTPUT FILE
  208. '<P> : OFLAG @ IF OFILE P1 @ P2 @ OVER - PUTBYTES ELSE
  209.   "NO OUTPUT FILE" ERR THEN ;
  210. 'PEOF :  OFILE EOF PUTBYTE EOF PUTBYTE SHRINK ;
  211. 'P : <M> <P> ;
  212. 'PL : <L> <P> ;
  213. 'PA : <ALL> <P> ;
  214.  
  215. % MOVE TEXT BUFFER DOWN
  216. 'DOWN : MEMORY @ LIMIT CP @ MEMORY @ - MVBYTES
  217.   S2 CP @ MEMORY @ LIMIT - - CP ! S1 LIMIT MEMORY ! ;
  218.  
  219. % MOVE TEXT BUFFER UP
  220. 'UP : CP @ 1- P2 @ 1- CP @ LIMIT - RMVBYTES
  221.   MEMORY @ P2 @ CP @ - + MEMORY !
  222.   P2 @ CP @ P1 @ - - P1 ! P1 CP MOVE ;
  223.  
  224. % APPEND TEXT FROM INPUT FILE
  225. '<A> : LINE-TERMINATOR ! IFLAG @ IF Z DOWN IFILE GETLINE UP
  226.   ELSE "NO INPUT FILE" ERR THEN ;
  227. '<AL> : 15 <A> ;
  228. '<AP> : 14 <A> ;
  229.  
  230. 'AL : <AL> IF "EOF" ERR THEN ;
  231. 'AP : <AP> IF "EOF" ERR THEN ;
  232.  
  233. % DELETE TEXT-BUFFER AND APPEND FROM INPUT FILE
  234. '<YL> : DA <AL> ;
  235. '<YP> : DA <AP> ;
  236. 'YL : DA AL ;
  237. 'YP : DA AP ;
  238.  
  239. % WRITE A PAGE AND READ NEXT PAGE
  240. '<R> : ( PA 1 <YP> ) ;
  241. 'R : ( PA 1 YP ) ;
  242.  
  243. % GLOBAL SEARCH AND REPLACE COMMANDS
  244. '<N> : BEGIN -1 OVER COUNT <S> IF DROP -1 -1 ELSE
  245.   1 <R> IF DROP 0 -1 ELSE 0 THEN THEN END ;
  246. 'N : <N> NOT IF 'MISSING ERR THEN ;
  247. 'V : SWAP N U ;
  248.  
  249. % CLOSE INPUT AND OUTPUT FILES
  250. 'IOCLOSE : IFLAG 0<- IFILE CLOSE OFLAG 0<- OFILE CLOSE FLUSH ;
  251.  
  252. % GET INPUT FILE
  253. 'GR : DUP INAME 7 MVBYTES IFILE OPEN IFLAG -1<- ;
  254.  
  255. % GET OUTPUT FILE
  256. 'GW : DUP ONAME 7 MVBYTES OFILE WOPEN OFLAG -1<- ;
  257.  
  258. % FLUSH TEXT BUFFER AND INPUT AND OUTPUT FILES
  259. 'GX : DA OFLAG @ IF ONAME DELETE THEN IOCLOSE ;
  260.  
  261. % OPEN INPUT FILE, CREATE SCRATCH FILE, READ 1ST PAGE OF INPUT FILE
  262. 'O : GR '**ED** GW 1 YP B ;
  263.  
  264. % WRITE OUT AND CLOSE FILES
  265. 'W : IFLAG @ IF BEGIN 1 <R> END PEOF
  266.   INAME DELETE ONAME INAME RENAME ELSE
  267.   PA PEOF THEN DA IOCLOSE ;
  268.  
  269. % WRITE AND RENAME
  270. 'WR : IFLAG @ IF BEGIN 1 <R> END ELSE PA THEN PEOF
  271.   SHRINK DA IOCLOSE ONAME SWAP RENAME ;
  272.  
  273. % WRITE AND RE-OPEN COMMANDS
  274. 'WO : W INAME O ;
  275. 'WRO : DUP WR O ;
  276.  
  277. % TEXT TYPE-OUT COMMANDS
  278. '<T> : P1 @ P2 @ OVER - TYPE ;
  279. 'T : <M> <T> ;
  280. 'TL : <L> <T> ;
  281. 'TA : <ALL> <T> ;
  282.  
  283. % ERASE SCREEN
  284. 'ERASE : "&33&H&33&J" MSG ;
  285.  
  286. % DISPLAY DIRECTORY, WAIT FOR CR
  287. 'FL : ERASE LIST-DIRECTORY BEGIN TYI 15 EQ END ;
  288.  
  289. % DISPLAY TEXT BUFFER
  290. 'DISPLAY : ERASE
  291.   IFLAG @ IF INAME COUNT 6 MIN TYPE ELSE 52 TYO THEN
  292.   54 TYO
  293.   OFLAG @ IF ONAME COUNT 6 MIN TYPE ELSE 52 TYO THEN
  294.   CR CR
  295.   CP @ <L -10 L 20 L CP @ DUP -20 L CP @
  296.   L> CP ! UDO I DISPLAY-CURSORS I B@ DISPLAY-CHAR ULOOP
  297.   DISPLAY-CURSORS ;
  298.  
  299. % EDITOR PROMPT MESSAGE
  300. 'EDIT-PROMPT :
  301.   CHECK B@ 60 EQ IF DISPLAY CR CR THEN
  302.   PROMPT0 ;
  303.  
  304. % EDITOR ERROR HANDLER
  305. 'ERRS : ERASE () <TTO> OUT ! () <TTI> IN ! MSG CR . MSG
  306.   BEGIN TYI 15 EQ END
  307.   ABORT ;
  308.  
  309. % EXIT EDITOR, FLUSH TEXT AND X BUFFERS
  310. 'H : GX ERASE () PROMPT0 PROMPT ! () ERRMSG0 ERRMSG ! >
  311.   XLAST MEMORY MOVE ;
  312.  
  313. % INSERT MODE
  314. 'I/DISPLAY : CP @ LAST @ OVER LAST ! DISPLAY LAST ! CP ! ;
  315.  
  316. 'I/ : DOWN I/DISPLAY BEGIN
  317.    CP @ P2 @ EQ IF "CORE FULL" ERR THEN
  318.    TYI DUP ESC @ EQ IF DROP -1 ELSE
  319.        DUP 177 EQ IF
  320.         DROP CP @ P1 @ NE IF CP 1-! I/DISPLAY THEN
  321.         0 ELSE
  322.        DUP EQZ IF DROP P1 CP MOVE I/DISPLAY 0 ELSE
  323.        DUP TYO CP @ B! CP 1+! 0 THEN THEN THEN
  324.   END UP P2 CP MOVE
  325. ;
  326.  
  327. % CONDITIONAL CHANGE COMMANDS
  328. 'CU :
  329.   DISPLAY "&15&TYPE A KEY" MSG TYI
  330.   DUP 15 EQ IF
  331.    DROP 0 ELSE
  332.    12 EQ IF
  333.     DUP U 0 ELSE
  334.     2DROP -1 THEN
  335.    THEN
  336. ;
  337.  
  338. 'CC : BEGIN OVER S CU END ;
  339. 'BCC : BEGIN OVER BS CU P1 CP MOVE END ;
  340. 'CV : BEGIN OVER N CU END ;
  341.  
  342. > DEFINITIONS
  343.  
  344. EDITOR<
  345. 'EDIT : () EDIT-PROMPT PROMPT ! () ERRS ERRMSG ! EDITOR<
  346.   MEMORY @ DUP LAST ! DUP XLAST ! DUP CP ! DUP P1 ! P2 ! ;
  347. >
  348.  
  349. RADIX !
  350. ;F
  351.  
  352.  
  353.  
  354. ***EOF***
  355.