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 / CPMUG038.ARK / PACKUP.ASM < prev    next >
Assembly Source File  |  1984-04-29  |  15KB  |  574 lines
  1. ;
  2. ; TITLE        PACK UP THE BUFFER AND MOVE ROUTINES FOR FAST.COM
  3. ; FILENAME    PACKUP.ASM
  4. ; AUTHOR    Robert A. Van Valzah   12/25/78
  5. ; LAST REVISED    R.A.V.   5/20/79
  6. ; REASON    MOVED DEFAULT OPTION STRING TO 130H
  7. ;
  8. ;
  9. BOOT    EQU    0
  10. CURDSK    EQU    4
  11. BDOS    EQU    5
  12. ;
  13. FCB1    EQU    5CH
  14. FCB2    EQU    6CH
  15. DBUF    EQU    80H
  16. DIRTRK    EQU    2    ;DIRECTORY TRACK
  17. MTYTRK    EQU    0FFH    ;TRACK NUMBER SHOWING A DDB IS EMPTY
  18. SECLEN    EQU    80H    ;LENGTH OF A SECTOR IN BYTES
  19. ;
  20. ;
  21.     ORG    100H
  22. ENTRY:
  23.     JMP    SKIPMES
  24.     DB    'Copyright (C) 1979, Robert A. Van Valzah'
  25.     DB    0,0,0,0,0 ;SO DFLTOPT IS AT NICE EASY BOUNDRY
  26. ;
  27. DFLTOPT:        ;OPTION STRING TO USE IF NONE SUPPLIED
  28.     DB    '[RS]     '
  29. ;
  30. ; SECTOR ORDER TABLES
  31. ;
  32. TRKSEC:
  33.     DB    26,25,24,23,22,21,20,19,18,17,16,15,14
  34.     DB    13,12,11,10, 9, 8, 7, 6, 5, 4, 3, 2, 1
  35.     DB    0    ;EOT MARKER
  36.     ; RESERVE SPACE FOR DOUBLE DENSITY SECTOR TABLE
  37.     DB    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0
  38.     DB    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0
  39. ;
  40. DIRSEC:
  41.     DB    25, 23, 21, 19, 17, 15, 14, 13
  42.     DB    11,  9,  8,  7,  5,  3,  2,  1
  43.     DB    0    ;EOT MARKER
  44.     ; RESERVE SPACE FOR DOBLE DENSITY
  45.     DB    0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0
  46.     PAGE
  47. ;
  48. ;    < < < < < <   FILE NAME PARSING SUBROUTINES > > > > > >
  49. ;
  50. ; GETFN GETS A FILE NAME FROM TEXT POINTED TO BY REG HL INTO
  51. ; AN FCB POINTED TO BY REG DE.  LEADING DELIMETERS ARE 
  52. ; IGNORED.
  53. ; ENTRY    HL    FIRST CHARACTER TO BE SCANED
  54. ;    DE    FIRST BYTE OF FCB
  55. ; EXIT    HL    CHARACTER FOLLOWING FILE NAME
  56. ;
  57. GETFN:
  58.     CALL    INITFCB    ;FILL FCB WITH DEFAULTS
  59.     CALL    GETSTART ;SCAN TO FIRST CHARACTER OF NAME
  60.     RZ        ;END OF LINE WAS FOUND - LEAVE FCB BLANK
  61.     CALL    GETDRV    ;GET DRIVE SPEC. IF PRESENT
  62.     CALL    GETPS    ;GET PRIMARY AND SECONDARY NAME
  63.     RET
  64. ;
  65. ; INITFCB FILLS AN FCB WITH THE DEFAULT INFORMATION.  THE
  66. ; DRIVE SPEC IS DEFAULTED TO THE CURRENT DRIVE, AND THE
  67. ; PRIMARY AND SECONDARY NAME BYTES ARE FILLED WITH BLANKS.
  68. ; ENTRY    DE    FIRST BYTE OF FCB
  69. ; EXIT    DE    PRESERVED
  70. ;    A,C    CLOBBERED
  71. ;
  72. INITFCB:
  73.     PUSH    D    ;SAVE FCB START
  74.     XRA    A    ;INIT DRIVE SPEC
  75.     STAX    D
  76.     INX    D    ;POINT TO PRIMARY NAME FIELD
  77.     MVI    A,' '    ;CHAR TO FILL NAMES WITH
  78.     MVI    C,11    ;LENGTH OF PRI AND SEC NAMES
  79. BLANKL:
  80.     STAX    D
  81.     INX    D
  82.     DCR    C
  83.     JNZ    BLANKL
  84.     POP    D    ;RESTORE FCB START POINTER
  85.     RET
  86.     PAGE
  87. ;
  88. ; GETSTART ADVANCES THE TEXT POINTER (REG HL) TO THE FIRST
  89. ; NON DELIMITER CHARACTER (I.E. IGNORES BLANKS).  RETURNS A
  90. ; FLAG IF END OF LINE (00H OR ';') IS FOUND WHILE SCANING.
  91. ; EXIT    HL    POINTING TO FIRST NON DELIMITER
  92. ;    A    CLOBBERED
  93. ;    ZERO    SET IF END OF LINE WAS FOUND
  94. ;
  95. GETSTART:
  96.     CALL    GETCH    ;SEE IF POINTING TO DELIM?
  97.     RNZ        ;NOPE - RETURN
  98.     CPI    ';'    ;END OF LINE?
  99.     RZ        ;YUP - RETURN W/FLAG
  100.     ORA    A
  101.     RZ        ;YUP - RETURN W/FLAG
  102.     INX    H    ;NOPE - MOVE OVER IT
  103.     JMP    GETSTART ;AND TRY NEXT CHAR
  104. ;
  105. ; GETDRV CHECKS FOR THE PRESENCE OF A DRIVE SPEC AT THE TEXT
  106. ; POINTER, AND IF PRESENT FORMATS IT INTO THE FCB AND
  107. ; ADVANCES THE TEXT POINTER OVER IT.
  108. ; ENTRY    HL    TEXT POINTER
  109. ;    DE    POINTER TO FIRST BYTE OF FCB
  110. ; EXIT    HL    POSSIBLY UPDATED TEXT POINTER
  111. ;    DE    POINTER TO SECOND (PRIMARY NAME) BYTE OF FCB
  112. ;
  113. GETDRV:
  114.     INX    D    ;POINT TO NAME IF SPEC NOT FOUND
  115.     INX    H    ;LOOK AHEAD TO SEE IF ':' PRESENT
  116.     MOV    A,M
  117.     DCX    H    ;PUT BACK IN CASE NOT PRESENT
  118.     CPI    ':'    ;IS A DRIVE SPEC PRESENT?
  119.     RNZ        ;NOPE - RETURN
  120.     MOV    A,M    ;YUP - GET THE ASCII DRIVE NAME
  121.     SUI    'A'-1    ;CONVERT TO FCB DRIVE SPEC
  122.     DCX    D    ;POINT BACK TO DRIVE SPEC BYTE
  123.     STAX    D    ;STORE SPEC INTO FCB
  124.     INX    D    ;POINT BACK TO NAME
  125.     INX    H    ;SKIP OVER DRIVE NAME
  126.     INX    H    ;AND OVER ':'
  127.     RET
  128.     PAGE
  129. ;
  130. ; GETPS GETS THE PRIMARY AND SECONDARY NAMES INTO THE FCB.
  131. ; ENTRY    HL    TEXT POINTER
  132. ; EXIT    HL    CHARACTER FOLLOWING SECONDARY NAME (IF PRESENT)
  133. ;
  134. GETPS:
  135.     MVI    C,8    ;MAX LENGTH OF PRIMARY NAME
  136.     CALL    GETNAM    ;PACK PRIMARY NAME INTO FCB
  137.     MOV    A,M    ;SEE IF TERMINATED BY A PERIOD
  138.     CPI    '.'
  139.     RNZ        ;NOPE - SECONDARY NAME NOT GIVEN
  140.             ;RETURN DEFAULT (BLANKS)
  141.     INX    H    ;YUP - MOVE TEXT POINTER OVER PERIOD
  142. FTPOINT:        ;YUP - UPDATE FCB POINTER TO SECONDARY
  143.     MOV    A,C
  144.     ORA    A
  145.     JZ    GETFT
  146.     INX    D
  147.     DCR    C
  148.     JMP    FTPOINT
  149. GETFT:
  150.     MVI    C,3    ;MAX LENGTH OF SECONDARY NAME
  151.     CALL    GETNAM    ;PACK SECONDARY NAME INTO FCB
  152.     RET
  153.     PAGE
  154. ;
  155. ; GETNAM COPIES A NAME FROM THE TEXT POINTER INTO THE FCB FOR
  156. ; A GIVEN MAXIMUM LENGTH OR UNTIL A DELIMITER IS FOUND, WHICH
  157. ; EVER OCCURS FIRST.  IF MORE THAN THE MAXIMUM NUMBER OF
  158. ; CHARACTERS IS PRESENT, CHARACTER ARE IGNORED UNTIL A
  159. ; A DELIMITER IS FOUND.
  160. ; ENTRY    HL    FIRST CHARACTER OF NAME TO BE SCANED
  161. ;    DE    POINTER INTO FCB NAME FIELD
  162. ;    C    MAXIMUM LENGTH
  163. ; EXIT    HL    POINTING TO TERMINATING DELIMITER
  164. ;    DE    NEXT EMPTY BYTE IN FCB NAME FIELD
  165. ;    C    MAX LENGTH - NUMBER OF CHARACTERS TRANSFERED
  166. ;
  167. GETNAM:
  168.     CALL    GETCH    ;ARE WE POINTING TO A DELIMITER YET?
  169.     RZ        ;IF SO, NAME IS TRANSFERED
  170.     INX    H    ;IF NOT, MOVE OVER CHARACTER
  171.     CPI    '*'    ;AMBIGIOUS FILE REFERENCE?
  172.     JZ    AMBIG    ;IF SO, FILL THE REST OF FIELD WITH '?'
  173.     STAX    D    ;IF NOT, JUST COPY INTO NAME FIELD
  174.     INX    D    ;INCREMENT NAME FIELD POINTER
  175.     DCR    C    ;IF NAME FIELD FULL?
  176.     JNZ    GETNAM    ;NOPE - KEEP FILLING
  177.     JMP    GETDEL    ;YUP - IGNORE UNTIL DELIMITER
  178. AMBIG:
  179.     MVI    A,'?'    ;FILL CHARACTER FOR WILD CARD MATCH
  180. FILL?:
  181.     STAX    D    ;FILL UNTIL FIELD IS FULL
  182.     INX    D
  183.     DCR    C
  184.     JNZ    FILL?
  185.             ;FALL THRU TO INGORE REST OF NAME
  186. GETDEL:
  187.     CALL    GETCH    ;POINTING TO A DELIMITER?
  188.     RZ        ;YUP - ALL DONE
  189.     INX    H    ;NOPE - IGNORE ANTOHER ONE
  190.     JMP    GETDEL
  191.     PAGE
  192. ;
  193. ; GETCH GETS THE CHARACTER POINTED TO BY THE TEXT POINTER
  194. ; AND SETS THE ZERO FLAG IF IT IS A DELIMITER.
  195. ; ENTRY    HL    TEXT POINTER
  196. ; EXIT    HL    PRESERVED
  197. ;    A    CHARACTER AT TEXT POINTER
  198. ;    Z    SET IF A DELIMITER
  199. ;
  200. GETCH:
  201.     MOV    A,M    ;GET THE CHARACTER
  202.     IRPC    CHAR,<.,; :=<>>
  203.       CPI    '&CHAR'
  204.       RZ
  205.     ENDM
  206.     ORA    A    ;SET ZERO FLAG ON END OF TEXT
  207.     RET
  208.     PAGE
  209. ;
  210. ;
  211. ;    <<<<<<    OPTION STRING PARSING SUBROUTINES   >>>>>>
  212. ;
  213. ;
  214. ; GETOPT GETS AN OPTION STRING FROM TEXT POINTED TO BY REG HL
  215. ; IF NO OPTION STRING IS PRESENT, THE DEFAULT STRING (DFLTOPT)
  216. ; IS PARSED INSTEAD.  AN OPTION STRING STARTS WITH '['.
  217. ;
  218. GETOPT:
  219.     CALL    GETSTART ;GET FIRST CHARACTER OF ARGUMENT
  220.     CPI    '['    ;IS THIS THE START OF AN OPTION STRING?
  221.     JZ    SCANOPT    ;IF SO - GO PARSE ARGUMENT STRING
  222.     PUSH    H    ;IF NOT - SAVE ARGUMENT TXA AND . . .
  223.     LXI    H,DFLTOPT ;PARSE DEFAULT STRING INSTEAD
  224.     CALL    SCANOPT
  225.     POP    H    ;GET ARG TXA BACK
  226.     RET
  227. ;
  228. ; SCAN AN OPTION STRING, CALLING DDB CREATION ROUTINES TO GIVE
  229. ; REQUESTED OPTIONS
  230. ;
  231. SCANOPT:
  232.     XCHG    ;SAVE OPTION TXA WHILE . . .
  233.     LHLD    BDOS+1    ;INITIALIZING DDB ALLOCATIN POINTER
  234.     MVI    L,0    ;MOVE DOWN TO PAGE BOUNDRY
  235.     SHLD    BUFSTRT
  236.     XCHG        ;GET OPTION TXA BACK
  237.     INX    H    ;MOVE OVER '['
  238. SCANDRV:
  239.     CALL    GETODRV    ;GET DRIVE SPEC IF PRESENT
  240.     MOV    A,C    ;SAVE DRIVE SPEC FOR DDB CREATION
  241.     STA    BUFDRV
  242. SCANBUF:
  243.     CALL    GETOBUF    ;GET BUFFER SPEC
  244.     MOV    A,C    ;WAS A BUFFER SPEC PRESENT?
  245.     CPI    4
  246.     JNZ    OPTOK    ;YES - THAT'S AN OK OPTION
  247.     MOV    A,B    ;NO - IT'S OK ONLY IF . . .
  248.     ORA    A    ;A DRIVE SPEC WAS PRESENT
  249.     JZ    OPTOK
  250. OPTERR:            ;GIVE OPTION ERROR AND REBOOT
  251.     LXI    D,OPTMES
  252.     MVI    C,9
  253.     CALL    BDOS
  254.     JMP    0
  255. ;
  256. OPTMES:
  257.     DB    'INVALID OPTION', 13, 10, '$'
  258. ;
  259. OPTOK:
  260.     PUSH    H    ;SAVE TXA DURING CREATION
  261.     CALL    CRTBUF    ;CREATE THE REQUESTED BUFFERS
  262.     POP    H    ;GET TXA BACK
  263.     CALL    GETOBUF    ;SEE IF ANY MORE BUFF SPEC PRESENT
  264.     MOV    A,C
  265.     CPI    4
  266.     JNZ    OPTOK    ;YES - GO CREATE THEM
  267.     CALL    GETOCH    ;NO - SEE IF OUT OF OPTION SPEC
  268.     JNZ    SCANDRV    ;NO - EXPECT ANOTHER DRIVE SPEC
  269.     RET        ;YES - OUR JOB HERE IS DONE
  270. ;
  271. ; GET AN OPTION DRIVE SPEC FROM TEXT, RETURNED IN REG C.
  272. ; IF NOT PRESENT, RETURN CURRENTLY LOGGED DISK AND SET FLAG.
  273. ;
  274. GETODRV:
  275.     LDA    CURDSK    ;GET CURRENT DISK IN CASE OF FAILURE
  276.     MOV    C,A
  277.     MVI    B,0FFH    ;SET DEFAULT FLAG ALSO
  278.     MOV    A,M    ;GET POSSIBLE DRIVE SPEC CHR
  279.     SUI    'A'    ;LESS THAN 'A'
  280.     RC        ;YES - RETURN TAKING DEFAULT
  281.     CPI    'D'-'A'+1 ;GREATER THAN 'D'?
  282.     RNC        ;YES - RETURN TAKING DEFAULT
  283.     MOV    C,A    ;NO - VALID SPEC WAS PRESENT, RETURN
  284.     MVI    B,0    ;IT IN REG C, AND RESET DEFAULT FLAG
  285.     INX    H    ;MOVE OVER VALID DRIVE SPEC CHARACTER
  286.     RET
  287. ;
  288. ; GET OPTION BUFFER SPECIFICATION, RETURNING CORRESPONDING
  289. ; TOKEN IN REG C.
  290. ; BUFFER     TOKEN
  291. ;  SPEC        RETURNED
  292. ; ======    ========
  293. ;   R           0        READ
  294. ;   W           1        WRITE TRACK
  295. ;   S           2        SEEK (DIRECTORY)
  296. ;   Y           3        YES (ALL OF THE ABOVE)
  297. ; <NULL>       4        NONE OF THE ABOVE
  298. ;
  299. GETOBUF:
  300.     MVI    C,4    ;PREPARE TO RETURN NULL IF
  301.     CALL    GETOCH
  302.     RZ        ;END OF OPTION IS FOUND
  303.     INX    H    ;ASSUME WE WILL FIND A SPEC, MOVE OVER
  304.     DCR    C    ;GET YES TOKEN
  305.     CPI    'Y'    ;RETURN IF YES SPEC
  306.     RZ
  307.     DCR    C    ;GET SEEK TOKEN
  308.     CPI    'S'    ;RETURN IF SEEK SPEC
  309.     RZ
  310.     DCR    C    ;GET WRITE TOKEN
  311.     CPI    'W'    ;RETURN IF WRITE TOKEN
  312.     RZ
  313.     DCR    C    ;GET READ TOKEN
  314.     CPI    'R'    ;RETURN IF READ TOKEN
  315.     RZ
  316.     DCX    H    ;SPEC NOT FOUND - BACKUP TO UNKNOWN CHR
  317.     MVI    C,4    ;AND RETURN DEFAULT TOKEN
  318.     RET
  319. ;
  320. ; GET AN OPTION CHARACTER FROM THE TEXT POINTER.  SET FLAGS
  321. ; IF END OF OPTION STRING FOUND
  322. ;
  323. GETOCH:
  324.     MOV    A,M    ;GET A CHARCTER
  325.     CPI    ' '    ;SPACE TERMINATES AN OPTION STRING
  326.     RZ
  327.     CPI    ']'    ;SO DOES RIGHT BRACKET, BUT
  328.     INX    H    ;MOVE TEXT POINTER OVER IT
  329.     RZ
  330.     DCX    H    ;NOT ']', GET TXA BACK
  331.     ORA    A    ;RETURN FLAG IF END OF ARGUMENT TO FAST
  332.     RET
  333.     PAGE
  334. ;
  335. ;
  336. ;    <<<<<<    DDB CREATION SUBROUTINES  >>>>>>
  337. ;
  338. ;
  339. ; CREATE ONE OR MORE DDB'S FROM A BUFFERING SPEC TOKEN AND
  340. ; A DRIVE SPEC
  341. ; 
  342. CRTBUF:
  343.     MOV    A,C    ;GET BUFFER TOKEN
  344.     ORA    A    ;READ TRACK?
  345.     JZ    CRT$R    ;YES - CREATE A READ DDB
  346.     DCR    C    ;WRITE TRACK?
  347.     JZ    CRT$W    ;YES - CREATE A WRITE DDB
  348.     DCR    C    ;SEEK
  349.     JZ    CRT$S    ;YES - CREATE A SEEK DDB
  350.     CALL    CRT$R    ;NONE OF THE ABOVE, MUST BE NULL OR Y
  351.     CALL    CRT$S    ;AND BOTH NEED READ AND SEEK
  352.     DCR    C    ;NULL?
  353.     RNZ        ;YES - READ AND SEEK ARE DONE - RETURN
  354.     CALL    CRT$W    ;NO - I.E. YES - CREATE WRITE DDB ALSO
  355.     RET
  356. ;
  357. ; CREATE A READ TRACK DDB
  358. ;
  359. CRT$R:
  360.     LXI    H,RDBUF    ;POINT TO READ DDB ADDRESS TABLE IN FAST
  361.     JMP    CRT$TDDB ;CONTINE TO CREATE A FULL TRACK DDB
  362. ;
  363. ; CREATE A WRITE TRACK DDB
  364. ;
  365. CRT$W:
  366.     LXI    H,WRBUF    ;POINT TO WRITE DDB ADDRESS TABLE
  367. CRT$TDDB:
  368.     LXI    D,TRKSEC ;POINT TO FULL TRACK SECTOR TABLE
  369.     CALL    CRT$DDB    ;CREATE A GENERALIZED DDB
  370.     MVI    A,MTYTRK ;SET DDB TO EMPTY TRACK
  371.     STAX    D
  372.     RET
  373. ;
  374. ; CREATE A SEEK DDB
  375. ;
  376. CRT$S:
  377.     LXI    H,DIRBUF ;POINT TO DIRECTORY DDB ADDRESS TABLE
  378.     LXI    D,DIRSEC ;PARTIAL TRACK (DIRECTORY) SECTOR TABLE
  379.     CALL    CRT$DDB
  380.     MVI    A,DIRTRK ;INITIALIZE TRACK TO DIRECTORY TRACK
  381.     STAX    D
  382.     RET
  383. ;
  384. ; GENERALIZED CREATE DDB ROUTINE.  A DDB FOR THE DRIVE IN
  385. ; BUFDRV IS CREATED USING THE SECTOR TABLE PASSED IN REG DE.
  386. ; THE ADDRESS OF THE DDB IS FILLED INTO THE DDB ADDRESS
  387. ; TABLE WITHIN FAST.  MEMORY IS DOWNSIZED BY THE LENGTH OF
  388. ; THE DDB.
  389. ;
  390. CRT$DDB:
  391.     PUSH    B    ;SAVE CALLERS REG BC
  392.     PUSH    H    ;SAVE DDB ADDRESS TABLE POINTER
  393.     LHLD    BUFSTRT    ;GET HIGHEST BYTE NOW IN USE
  394.     DCX    H    ;POINT TO NEXT FREE BYTE
  395.     MVI    M,0    ;PUT IN END OF DDB MARKER
  396.     LDAX    D    ;GET LAST SECTOR NUMBER TO REG A
  397.     LXI    B,-(SECLEN+2) ;NEGATIVE LENGHT BETWEEN SECTORS
  398. FILLSEC:
  399.     DAD    B    ;POINT TO UPDATE FLAG
  400.     MVI    M,0    ;RESET UPDATE FLAG
  401.     DCX    H    ;POINT TO SECTOR NUMBER FIELD
  402.     MOV    M,A    ;FILL IN ANOTHER SECTOR NUMBER
  403.     LDA    LEN+1    ;HIGH ORDER LENGTH INTO REG A
  404.     ADI    (HIGH CODE1)+1 ;ADD FAST START ADDRESS TO GIVE
  405.             ;HIGH ORDER MINIMUM BUFFER START
  406.     CMP    H    ;IS NEW BUFFER START LESS THAN MIN?
  407.     JNC    OMERR    ;YES - GIVE OUT OF MEMORY ERROR
  408.     INX    D    ;POINT TO NEXT SECTOR NUMBER FROM TABLE
  409.     LDAX    D    ;GET NEXT SECTOR
  410.     ORA    A    ;END OF TABLE?
  411.     JNZ    FILLSEC    ;NO - KEEP ALLOCATING SECTORS
  412.     DCX    H    ;NOW POINTING TO DRIVE FIELD OF DDB
  413.     LDA    BUFDRV    ;GET DRIVE FOR THIS DDB
  414.     MOV    M,A    ;AND FILL IT IN
  415.     DCX    H    ;AND LEAVE ROOM FOR TRACK NUMBER
  416.     SHLD    BUFSTRT    ;DOWNSIZE MEMORY
  417.     XCHG        ;DDB ADDRESS TO REG DE
  418.     POP    H    ;POINTER TO DDB ADDRESS TABLE TO REG HL
  419.     ADD    A    ;DOUBLE DRIVE NUMBER TO INDEX INTO TABLE
  420.     MOV    C,A    ;FORM INDEX IN REG BC
  421.     MVI    B,0
  422.     DAD    B    ;ADD INDEX TO BASE
  423.     MOV    A,M    ;MAKE SURE NO DDB EXISTS FOR THIS SPEC
  424.     INX    H
  425.     ORA    M
  426.     JNZ    OPTERR    ;ONE EXISTS - SPECIFIED TWICE ERROR
  427.     MOV    M,D    ;EMPTY SO FAR, SO FILL IN DDB ADDRESS
  428.     DCX    H
  429.     MOV    M,E
  430.     POP    B    ;RESTORE CALLERS REG BC
  431.     RET
  432. ;
  433. OMERR:
  434.     MVI    C,9    ;PRINT ERROR MESSAGE AND BOOT
  435.     LXI    D,OMMES
  436.     CALL    BDOS
  437.     JMP    BOOT
  438. ;
  439. OMMES:    DB    'OUT OF MEMORY$'
  440.     RET
  441.     PAGE
  442. ;
  443. ;
  444. ;    <<<<<<<  MAIN LINE CODE STARTS HERE  >>>>>>>>
  445. ;
  446. SKIPMES:
  447.     LXI    SP,STACK ;SETUP LOCAL STACK
  448.     LDA    DBUF    ;GET LENGHT OF ARGUMENT TO FAST COMMAND
  449.     ADI    DBUF+1    ;COMPUTE ADDRESS OF LAST CHAR + 1
  450.     MOV    L,A
  451.     MVI    H,HIGH DBUF
  452.     MVI    M,0    ;FOLLOW ARGUMENT WITH A 0 TO EASE PARSING
  453. ;
  454. ; REPACK ARGUMENT BUFFER TO ELIMINATE ARGUMENTS TO FAST.
  455. ;
  456.     LXI    H,DBUF+1 ;POINT TO FIRST CHAR OF ARG
  457.     CALL    GETOPT    ;GET OPTIONS AS NECESSARY
  458.     LXI    D,COMFCB ;PACK TRANSIENT FCB INTO FAST
  459.     CALL    GETFN    ;MOVE TEXT POINTER PAST COM FILE NAME
  460.     LXI    D,DBUF+1 ;DESTINATION FOR REPACKED ARG
  461.     MOV    A,L    ;COMPUTE LENGTH OF FAST ARGUMENT
  462.     SUB    E
  463.     MOV    C,A    ;SAVE IN REG C
  464.     LDA    DBUF    ;GET TOTAL ARG LEGTH
  465.     SUB    C    ;SUBTRACT FAST ARG LENGTH
  466.     STA    DBUF    ;LEAVING LENGTH OF TRANSIENT ARG
  467.     MOV    C,A    ;THIS IS ALSO LENGTH TO REPACK
  468.     INR    C    ;ADD ONE FOR END OF TEXT BYTE
  469.     CALL    MOVESUB    ;ACTUALLY DO THE REPACKING
  470. ;
  471.     LXI    H,DBUF+1 ;NOW PACK FCB'S FOR TRANSIENT
  472.     LXI    D,FCB1
  473.     CALL    GETFN    ;PACK FCB1
  474.     LXI    D,FCB2
  475.     CALL    GETFN    ;PACK FCB2
  476.     LXI    H,COMFCB+9 ;FILL IN TRANSIENT FILE TYPE 'COM'
  477.     MVI    M,'C'
  478.     INX    H
  479.     MVI    M,'O'
  480.     INX    H
  481.     MVI    M,'M'
  482.     PAGE
  483. ;
  484. ; NOW THAT DBUF AND FCB'S HAVE BEEN REPACKED, BEGIN THE UPWARD
  485. ; MOVEMENT AND RELOCATION OF FAST.
  486. ;
  487.     LHLD    LEN    ;GET LENGTH OF FAST CODE
  488.     MOV    B,H    ;INTO BC TO
  489.     MOV    C,L
  490.     LDA    BUFSTRT+1 ;GET PAGE OF LOWEST BUFFER
  491.     SUB    B    ;DOWNSIZE MEMORY BY LENGHT OF FAST
  492.     MOV    H,A
  493.     PUSH    H    ;SAVE DEST FOR ENTRY WHEN RELOC IS DONE
  494.     LXI    D,CODE1    ;POINTER TO CODE ORGED FOR 0
  495.  
  496. MOVEREL:
  497.     PUSH    B    ;SAVE LENGTH
  498.     PUSH    H    ;SAVE DEST
  499. MOVE:
  500.     LDAX    D    ;GET A BYTE FROM CODE 1 IMAGE
  501.     MOV    M,A    ;MOVE TO DEST
  502.     INX    D    ;BUMP CODE 1 POINTER
  503.     INX    H    ;BUMP DEST POINTER
  504.     DCX    B    ;MOVED WHOLE THING YET?
  505.     MOV    A,B
  506.     ORA    C
  507.     JNZ    MOVE
  508.  
  509.     POP    H    ;GET DEST BACK
  510.     POP    B    ;GET LENGTH BACK
  511.     PUSH    D    ;PUSH BASE OF RELTBL
  512.     MOV    D,H    ;BIAS IN REG D
  513. NEWBYT:
  514.     XTHL        ;GET RELOC TBL ADR
  515.     MOV    E,M    ;KEEP A REL BYTE IN REG E
  516.     INX    H    ;BUMP RELOC TBL POINTER
  517.     XTHL        ;PUT TBL PTR BACK
  518. RELBYT:
  519.     MOV    A,E    ;GET RELOC BYTE
  520.     RLC        ;MOVE A BIT INTO CARY
  521.     MOV    E,A    ;SAVE THE REST OF THE RELOC BITS
  522.     JNC    NOREL    ;BIT WAS 0, DON'T RELOCATE THIS BYTE
  523.     MOV    A,D    ;GET BIAS TO ADD
  524.     ADD    M    ;ADD TO BYTE FROM DEST
  525.     MOV    M,A
  526. NOREL:
  527.     INX    H    ;BUMP DEST POINTER
  528.     DCX    B    ;DONE WITH ALL BYTES?
  529.     MOV    A,B
  530.     ORA    C
  531.     JZ    MOVEDONE ;YUP - VECTOR TO REL BASE
  532.     MOV    A,L    ;NOPE - TEST IF AT 8 BYTE BOUNDRY
  533.     ANI  0000$0111B    ;IF SO, TIME FOR A NEW BYTE FROM TABLE
  534.     JNZ    RELBYT    ;NOT AT BOUNDRY
  535.     JMP    NEWBYT    ;AT A BOUNDRY
  536.  
  537. MOVEDONE:
  538.     POP    B    ;REMOVE RELOC TBL ADR FROM STACK
  539.     RET        ;VECTOR TO FAST ENTRY
  540. ;
  541. MOVESUB:
  542.     MOV    A,M
  543.     STAX    D
  544.     INX    D
  545.     INX    H
  546.     DCR    C
  547.     JNZ    MOVESUB
  548.     RET
  549. ;
  550. ; RAM AREAS
  551. ;
  552.     DS    20    ;STACK SPACE
  553. STACK:
  554. ;
  555. BUFDRV    DB    0    ;TEMP FOR OPTION DRIVE SPEC SCAN
  556. BUFSTRT    DW    0    ;LOWEST ADDRESS USED FOR BUFFERS
  557. ;
  558.     ORG    (($-1) OR 255) + 1 ;ORG TO NEXT PAGE BOUNDRY
  559. BIAS:    ;BIAS USED TO LOAD FAST ORGED FOR 0
  560. CODE1:    ;BASE ADDRESS OF CODE ORGED FOR 0
  561.     DS    3    ;MOVE OVER ENTRY JMP
  562. LEN:    ;WORD HOLDING LENGTH OF FAST CODE
  563.     DS    2
  564. COMFCB:            ;FCB FOR COM FILE TO BE LOADED
  565.     DS    33
  566.     ORG    CODE1+100H ;FIRST ADDRESS NOT OVERLAID
  567.     DS    6    ;SPACE FOR BDOS SERIAL NUMBER
  568.     DS    3    ;SPACE FOR JMP TO REAL BDOS
  569. RDBUF    DS    8    ;READ TRACK DDB ADDRESS TABLE
  570. WRBUF    DS    8    ;WRITE TRACK DDB ADDRESS TABLE
  571. DIRBUF    DS    8    ;DIRECTORY DDB ADDRESS TABLE
  572. ;
  573.     END    ENTRY
  574.