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 / STOICFLE.STC < prev    next >
Text File  |  1984-04-29  |  8KB  |  238 lines
  1.  
  2.  
  3.  
  4. % ***************************************************************************
  5. % ** COPYRIGHT (C) MASSACHUSETTS INSTITUTE OF TECHNOLOGY AND HARVARD       **
  6. % ** UNIVERSITY, BIOMEDICAL ENGINEERING CENTER 1977.  ALL RIGHTS RESERVED. **
  7. % ***************************************************************************
  8.  
  9. % 8080 FILE SYSTEM
  10. % TAPE VERSION
  11. % J. SACHS 3/7/77
  12.  
  13. RADIX @ OCTAL
  14.  
  15. % ADDRESS BLOCK-NUMBER NUMBER-OF-BLOCKS RDBLKS
  16. % READS BLOCKS DIRECTLY FROM MASS STORAGE DEVICE INTO MEMORY
  17. 'RDBLKS CODE<  B POP,  H POP,  UNIT LDA,  A ORA,  RAL,  H ORA,  A H MOV,
  18.   D POP,  (READ) CALL,  NEXT JMP,  >
  19.  
  20. % ADDRESS BLOCK-NUMBER NUMBER-OF-BLOCKS WRBLKS
  21. % WRITES BLOCKS DIRECTLY FROM MEMORY TO THE MASS STORAGE DEVICE
  22. 'WRBLKS CODE<  B POP,  H POP,  UNIT LDA,  A ORA,  RAL,  H ORA,  A H MOV,
  23.   D POP,  (WRITE) CALL,  NEXT JMP,  >
  24.  
  25. % CONSTANTS AND VARIABLES
  26. 4 'EOF CONSTANT        % END OF FILE CODE
  27. 1000 'NBLKS CONSTANT    % # OF BLOCKS ON MASS STORAGE DEVICE
  28. 2000 'BSIZE CONSTANT    % # OF BYTES PER BLOCK
  29. 0 'FCT VARIABLE        % FILE CONTROL TABLE POINTER
  30. 0 'ENTP0 VARIABLE    % 2 TEMPORARY VARIABLES
  31. 0 'ENTP1 VARIABLE
  32.  
  33. % DEFINE FILE CONTROL TABLE VARIABLES
  34. 'FCTBLK0 CODE<  FCT LHLD,  PUSH JMP,  >
  35. 'FCTUNIT CODE<  2 D LXI,  .  .  FCT LHLD,  D DAD,  PUSH JMP,  >
  36. 'FCTBLK CODE<  4 D LXI,  JMP,  >
  37. 'FCTBYTE CODE<  6 D LXI,  JMP,  >
  38.  
  39. % GET ADDRESS OF DIRECTORY BUFFER
  40. 'DIRECTORY : 0 RBLOCK ;
  41.  
  42. % GET NEXT DIRECTORY ENTRY
  43. 'NXENT0 : DIRECTORY 10 - ENTP0 ! ;
  44. 'NXENT : 10 ENTP0 +! ENTP0 @@ ;
  45.  
  46. % GET STARTING BLOCK # GIVEN PTR TO DIRECTORY ENTRY
  47. 'SBLK : 6 + @ 777 AND ;
  48.  
  49. % FILENAME MATCH
  50. 'MATCH CODE<  B POP,  H POP,  6 E MVI,  .  B LDAX,  M CMP,  0PUSH JNZ,
  51.   A ORA,  -1PUSH JZ,  B INX,  H INX,  E DCR,  JNZ,  -1PUSH JMP,  >
  52.  
  53. % SEARCH FOR MATCH IN DIRECTORY
  54. 'SEARCH : NXENT0 BEGIN NXENT IF ENTP0 @ OVER 1+ MATCH IF
  55.   DROP ENTP0 @ -1 -1 ELSE 0 THEN ELSE DROP 0 -1 THEN END ;
  56.  
  57. % TEST IF FILE EXISTS
  58. 'EXIST : SEARCH NOT IF "FILE DOES NOT EXIST" ERR THEN ;
  59.  
  60. % TEST IF FILE DOES NOT EXIST
  61. 'NOT-EXIST : SEARCH IF "FILE ALREADY EXISTS" ERR THEN ;
  62.  
  63. % GET PTR TO LAST DIRECTORY ENTRY
  64. 'SLOT : DIRECTORY BEGIN DUP @ IF 10 + REPEAT ;
  65.  
  66. % TEST IF FILE IS OPEN
  67. 'OPEN? : FCTBLK0 EQZ FCTBLK0 @ EQZ OR IF "FILE NOT OPEN" ERR THEN ;
  68.  
  69. % GET FILE POSITION
  70. 'GPOS : OPEN? FCTBLK @ BSIZE UM* FCTBYTE @ M+ ;
  71.  
  72. % SET FILE POSITION
  73. 'SPOS : OPEN? BSIZE UM/MOD FCTBYTE ! FCTBLK ! ;
  74.  
  75. % INITIALIZE DIRECTORY
  76. 'ZERO-DIRECTORY : DIRECTORY BSIZE 2/ 0FILL 1 DIRECTORY 6 + ! UPDATE ;
  77.  
  78. % SQUASH DELETE ENTRIES FROM END OF DIRECTORY
  79. 'FSQUASH : SLOT BEGIN DUP DIRECTORY NE SWAP 10 - DUP @ -1 EQ 2SWAP
  80.   AND IF DUP 3 0FILL UPDATE REPEAT DROP ;
  81.  
  82. % DELETE FILE
  83. 'DELETE : EXIST -1<- UPDATE FSQUASH ;
  84.  
  85. % RENAME FILE
  86. 'RENAME : DUP NOT-EXIST 1+ SWAP EXIST 6 MVBYTES UPDATE ;
  87.  
  88. % CREATE CONTIGUOUS FILE
  89. 'CCONT : OVER NOT-EXIST SLOT DUP DIRECTORY BSIZE 10 - + LT IF
  90.   SWAP OVER SBLK + DUP NBLKS GE IF "TAPE FULL" ERR THEN OVER
  91.   16 + ! DUP 10 + 3 0FILL SWAP 1+ SWAP 6 MVBYTES ELSE
  92.   "DIRECTORY FULL" ERR THEN UPDATE ;
  93.  
  94. % DEFINE FILE CONTROL TABLE
  95. 'FILE : 4 SWAP ARRAY ;CODE<  XCHG,  FCT SHLD,  NEXT JMP,  >
  96.  
  97. % COMPUTE # OF BLOCKS LEFT ON STORAGE DEVICE
  98. 'LEFT : NBLKS SLOT SBLK - ;
  99.  
  100. % LIST FILENAME
  101. 'LIST-NAME : DUP 6 + SWAP DO I B@ DUP IF TYO ELSE DROP EXIT
  102.   THEN LOOP ;
  103.  
  104. % LIST DIRECTORY
  105. 'LIST-DIRECTORY : IFCR NXENT0 BEGIN NXENT ENTP0 @ SBLK U<#>
  106.   4 OVER - SPACES TYPE SPACE IF ENTP0 @@ -1 EQ IF "(--)" 1+
  107.   ELSE ENTP0 @ THEN LIST-NAME 0 ELSE -1 THEN COLUMN B@ 16 GT
  108.   IF CR ELSE 16 TAB THEN END ;
  109.  
  110. % OPEN FILE
  111. 'OPEN : EXIST SBLK FCTBLK0 ! UNIT B@ FCTUNIT ! FCTBLK 0<- FCTBYTE 0<- ;
  112.  
  113. % CLOSE FILE
  114. 'CLOSE : FCTBLK0 0<- ;
  115.  
  116. % OPEN FOR WRITING
  117. 'WOPEN : DUP SEARCH IF DROP DUP DELETE THEN DUP LEFT 1- DUP LEZ IF
  118.   "TAPE FULL" ERR THEN CCONT OPEN ;
  119.  
  120. % GIVE BACK UNUSED BLOCKS
  121. 'SHRINK : OPEN? FCTBLK0 @ FCTBLK @ + FCTBYTE @ NEZ - SLOT 6 + ! UPDATE ;
  122.  
  123. % EXECUTE A FILE
  124. 'LOAD : EXIST SBLK LOAD ;
  125.  
  126.  
  127. ASSEMBLER< DEFINITIONS
  128.  
  129. % GET NEXT BYTE FROM FILE
  130.   . <L . <L "FILE NOT OPEN" S,
  131.  
  132.   .  FCT LHLD,  H A MOV,  L ORA,  IFZ,  M E MOV,  H INX,  M D MOV,
  133.   D A MOV,  E ORA,  IFZ,  H INX,  M A MOV,  H INX,  A ORA,  RAL,  D ORA,
  134.   A D MOV,  H INX,  M C MOV,  H INX,  M B MOV,  H INX,
  135.   XCHG,  B DAD,  XCHG,  H PUSH,  (RBLOCK) CALL,  H POP,  M C MOV,  H INX,
  136.   M B MOV,  XCHG,  B DAD,  H PUSH,  XCHG,  B INX,  C A MOV,
  137.   BSIZE 400 MOD CPI,  IFNZ,  B A MOV,  BSIZE 400 / CPI,  IFNZ,  H DCX,
  138.   H DCX,  H DCX,  M INR,  IFNC,  H INX,  M INR,  H DCX,  THEN,  H INX,
  139.   H INX,  H INX,  0 B LXI,  THEN,  THEN,  B M MOV,  H DCX,  C M MOV,  H POP,
  140.   M A MOV,  RET,  THEN,  THEN,  L> H LXI,  ERROR JMP,
  141. '(GETBYTE) CONSTANT
  142.  
  143. % PUT NEXT BYTE IN FILE
  144.   .  PSW PUSH,  FCT LHLD,  H A MOV,  L ORA,  IFZ,  M E MOV,  H INX,  M D MOV,
  145.   D A MOV,  E ORA,  IFZ,  H INX,  M A MOV,  H INX,  A ORA,  RAL,  D ORA,
  146.   A D MOV,  H INX,  M C MOV,  H INX,  M B MOV,  H INX,
  147.   XCHG,  B DAD,  XCHG,  H PUSH,  (RBLOCK) CALL,  H POP,  M C MOV,  H INX,
  148.   M B MOV,  XCHG,  B DAD,  H PUSH,  XCHG,  B INX,  C A MOV,
  149.   BSIZE 400 MOD CPI,  IFNZ,  B A MOV,  BSIZE 400 / CPI,  IFNZ,  H DCX,
  150.   H DCX,  H DCX,  M INR,  IFNC,  H INX,  M INR,  H DCX,  THEN,  H INX,
  151.   H INX,  H INX,  0 B LXI,  THEN,  THEN,  B M MOV,  H DCX,  C M MOV,  H POP,
  152.   PSW POP,  A M MOV,  NEWEST LHLD,  6 D LXI,  D DAD,  -1 M MVI,  H INX,
  153.   -1 M MVI,  RET,  THEN,  THEN,  L> H LXI,  ERROR JMP,
  154. '(PUTBYTE) CONSTANT
  155.  
  156. > DEFINITIONS
  157.  
  158. 'GETBYTE CODE<  (GETBYTE) CALL,  A L MOV,  0 H MVI,  PUSH JMP,  >
  159. 'PUTBYTE CODE<  H POP,  L A MOV,  (PUTBYTE) CALL,  NEXT JMP,  >
  160.  
  161. % GET NEXT N BYTES
  162. 'GETBYTES CODE<  H POP,  D POP,  H A MOV,  A ORA,  NEXT JM,  L ORA,
  163.   NEXT JZ,  .  D PUSH,  H PUSH,  (GETBYTE) CALL,  H POP,  D POP,
  164.   D STAX,  D INX,  H DCX,  H A MOV,  L ORA,  JNZ,  NEXT JMP,  >
  165.  
  166. % PUT NEXT N BYTES
  167. 'PUTBYTES CODE<  H POP,  D POP,  H A MOV,  A ORA,  NEXT JM,  L ORA,
  168.   NEXT JZ,  .  D PUSH,  H PUSH,  D LDAX,  (PUTBYTE) CALL,  H POP,  D POP,
  169.   D INX,  H DCX,  H A MOV,  L ORA,  JNZ,  NEXT JMP,  >
  170.  
  171. % PUSH THE # OF BLOCK OF FREE MEMORY (ERROR IF 0)
  172. 'MAXBL : MEMORY @ . - BSIZE / DUP EQZ IF "INSUFFICIENT MEMORY" ERR THEN ;
  173.  
  174. % BLK1 BLK2 NBLKS MVBLOCKS
  175. % MOVES NBLKS BLOCKS FROM BLK1 TO BLK2
  176. 'MVBLOCKS : DUP 0 DO
  177.   . 3OVER I + 2OVER MAXBL MIN RDBLKS . 2OVER I + 2OVER MAXBL MIN WRBLKS
  178.   MAXBL - MAXBL +LOOP 3DROP ;
  179.  
  180. % SQUASH THE DIRECTORY
  181. 'SQ : ENTP0 @ SBLK ENTP1 @ SBLK ENTP0 @ 10 + SBLK ENTP0 @ SBLK - MVBLOCKS
  182.   ENTP1 @ SBLK ENTP0 @ SBLK - DUP ENTP0 @ 10 + SBLK + SWAP ENTP0 @ 6 + +!
  183.   ENTP0 @ ENTP1 @ 10 MVBYTES ENTP1 @ 10 + 3 0FILL ENTP1 @ 16 + ! 10 ENTP1 +! ;
  184.  
  185. 'SQUASH : FLUSH FSQUASH NXENT0 BEGIN NXENT 1+ U2/ EQZ END ENTP0 ENTP1
  186.   MOVE ENTP0 @@ IF BEGIN BEGIN NXENT 1+ END ENTP0 @@ IF SQ UPDATE 0 ELSE
  187.   -1 THEN END THEN FLUSH ;
  188.  
  189. % READ AND WRITE CORE IMAGE
  190. '(RDCI) CODE<  D POP,  4 H LXI,  SP DAD,  T1 SHLD,  B POP,  H POP,
  191.   T1 2+ SHLD,  MEMORY LHLD,  SPHL,  T1 2+ LHLD,  UNIT LDA,  A ORA,  RAL,
  192.   H ORA,  A H MOV,  (READ) CALL,
  193. .  HEX
  194.   T1 LHLD,  SPHL,
  195.   0C000 H LXI,  55 A MVI,  .  H DCX,  A M MOV,  M CMP,  JNZ,  H INX,
  196.   MEMORY SHLD,  NEXT JMP,  >
  197. '(RESTART) CONSTANT
  198.  
  199. '(WRCI) CODE<  D POP,  4 H LXI,  SP DAD,  T1 SHLD,  B POP,  H POP,
  200.   T1 2+ SHLD,  MEMORY LHLD,  SPHL,  T1 2+ LHLD,  UNIT LDA,  A ORA,  RAL,
  201.   H ORA,  A H MOV,  (WRITE) CALL,
  202.   T1 LHLD,  SPHL,  NEXT JMP,  >
  203.  
  204. OCTAL
  205.  
  206. 'RDCI : EXIST DUP SBLK SWAP 10 + SBLK OVER - STATE (RDCI) ;
  207. 'WRCI : SLOT SBLK SWAP . STATE - BSIZE U/MOD NEZ - SWAP
  208.   OVER CCONT FLUSH STATE (WRCI) ;
  209.  
  210. HEX
  211.  
  212. % WRITE BOOTSTRAP FILE
  213. 'WRITE-BOOT : SLOT SBLK DUP WBLOCK DUP 2000 <- 2+ (RESTART)
  214.   <- 1+ SWAP . 2000 - BSIZE U/MOD NEZ - SWAP OVER 1+ CCONT
  215.   FLUSH EBUF 2000 (WRCI) ;
  216.  
  217. OCTAL
  218.  
  219. % DEFINE TWO FILE CONTROL TABLES
  220. 'IFILE FILE
  221. 'OFILE FILE
  222.  
  223. % TYPE A FILE
  224. 'PRINT : IFILE OPEN BEGIN GETBYTE DUP EOF NE IF TYO REPEAT
  225.   DROP CLOSE ;
  226.  
  227. % COPY A FILE
  228. 'XFER : OFILE WOPEN IFILE OPEN BEGIN IFILE GETBYTE DUP OFILE
  229.   PUTBYTE EOF EQ END IFILE CLOSE OFILE SHRINK CLOSE ;
  230.  
  231. RADIX !
  232. ;F
  233.  
  234.  
  235.  
  236. ***EOF***
  237.  
  238.