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