DataMuseum.dk

top - download

    Length: 6112 (0x17e0)
    Notes: Mikados TextFile, Mikados_K
    Names: »RENAMF«

└─⟦38ff28550⟧ Bits:30004682 Pascal Standard Assembler til MIKADOS
    └─ ⟦this⟧ »RENAMF« 

Text

;*************************************************************
;*         PASCAL STANDARD ASSEMBLER PACKAGE.                *
;*                                                           *
;* (C) 1980 DANSK DATA ELEKTRONIK APS.                       *
;*************************************************************
;
;*************************************************************
;* PROCEDURE NAME:      RENAMF                               *
;*************************************************************
;
; CT 22-SEP-1980
;
;=============================================================
; DESCRIPTION:
; THIS PROCEDURE RENAMES A MIKADOS FILE.
; PLEASE REFER TO THE PASCAL STANDARD ASSEMBLER PACKAGE MANUAL
; SECTION 8.1 FOR DETAILS.
;
;-------------------------------------------------------------
; STACK CONTENTS ON ENTRY:     I               I
;                              I---------------I
;                              I  RETURN ADR.  I
;                              I---------------I
;                              I  -> NEWNAME   I
;                              I---------------I
;                              I  -> OLDNAME   I
;                              I---------------I
;                              I               I
;-------------------------------------------------------------
; STACK CONTENTS ON EXIT:      EMPTY
;=============================================================
 
       SKIP
       SYMB
 
RENAMF::
 
;
;GET AND SAVE POINTERS FROM STACK
;
       POP     D       ;DE=RETURN ADDRESS
       POP     H       ;HL->NEWNAME
       SHLD    NEWPTR  ;SAVE ADDRESS OF NEWNAME
       POP     H       ;HL->OLDNAME
       SHLD    OLDPTR  ;SAVE ADDRESS OF OLDNAME
       PUSH    D       ;PUT RETURN ADDRESS BACK ON STACK
 
;
;CHECK THAT THERE IS ROOM ON THE HEAP FOR THE DCB
;
       LHLD    NP      ;HL->NEXT VACANT IN HEAP
       XCHG            ;DE->NEXT VACANT IN HEAP
       LXI     H,-#256-#48-#40-#10 ;HL:=REQUIRED DISTANCE
                                   ; BETWEEN STACK AND HEAP
       DAD     SP
       MOV     A,L     ;CALCULATE DISTANCE
       SUB     E
       MOV     A,H
       SBB     D       ;IS IT SUFFICIENT?
       JNC     SUFF    ;YES
       MVI     E,'K'   ;(SET UP ERROR CODE FOR UNSIFFICENT
                       ;  STACK LENGTH)
       JMP     XEQRR   ;NO. TERMINATE WITH RUN TIME ERROR K
       
SUFF:  XCHG            ;YES. HL->TOP OF HEAP
       SHLD    DCBADR  ;THIS SHOULD BE THE DATA CONTROL BLOCK
       LXI     D,#256+#48 ;RESERVE ROOM
       DAD     D          ;   ON HEAP
       SHLD    NP         ;      FOR DCB
       
;
;THE FOLLOWING CODE BUILDS AND PUSHES THE PARAMETERS FOR THE
;RENAM SUBROUTINE
;
       LXI     D,1     ;DCB SIZE
       PUSH    D
 
;
;BLANK OLDNAM AND NEWNAM
;
       MVI     A,#16    ;A=LENGTH OF FIELD TO BE BLANKED
       LXI     H,OLDNAM ;HL->FIELD TO BE BLANKED (OLDNAM AND
                        ;         NEWNAM ARE CONTIGUOUS)
       CALL    E0LIN    ;BLANK IT!
 
;
;MOVE CURRENT FILE NAME TO OLDNAM. THE CURRENT FILE NAME IS
;TERMINATED BY A ':'
;
       LXI     B,OLDNAM ;BC->OLDNAM
       LHLD    OLDPTR   ;HL->OLDNAME PARAMETER
       INX     H        ;SKIP LENGTH OF OLDNAME PARAMETER
NEXOLD:MOV     A,M      ;A:=A CHARACTER FROM OLDNAME PARAMETER
       CPI     ':'      ;IS IT A COLON?
       JZ      GETDSC   ;YES, WE ARE FINISHED
       STAX    B        ;NO, STORE IT IN OLDNAM
       INX     H        ;POINT TO
       INX     B        ;   NEXT CHARACTER
       JMP     NEXOLD   ;AND DO IT ONCE MORE
 
;
;GET DISC ID
;
GETDSC:INX     H        ;HL->DISC ID IN OLDNAME PARAMETER
       MOV     C,M      ;GET
       INX     H        ;  DISC ID
       MOV     B,M      ;    INTO BC
       INX     H        ;SKIP THE SUBSEQUENT COLON
       PUSH    B        ;PUSH DISC ID
 
;
;GET FILE TYPE
;
       INX     H        ;HL->FILE TYPE
       MOV     B,M      ;B:=FILE TYPE
       PUSH    B        ;PUSH FILE TYPE IN MSB.
 
;
;MOVE NEW FILE NAME TO NEWNAM
;
       LXI     B,NEWNAM ;BC->NEWNAM
       LHLD    NEWPTR   ;HL->NEWNAME PARAMETER
       MOV     D,M      ;D:=LENGTH OF NEWNAME
       INX     H        ;HL->FIRST CHAR IN NEWNAME
NEXNEW:MOV     A,M      ;A:=A CHARACTER FROM NEWNAME PARAMETER
       STAX    B        ;STORE THE CHARACTER IN NEWNAM
       INX     H        ;POINT TO
       INX     B        ;  NEXT CHARACTER
       DCR     D        ;ANY MORE CHARACTERS LEFT?
       JNZ     NEXNEW   ;YES, DO IT AGAIN
 
;
;SET UP REMAINING PARAMETERS FOR RENAM SUBROUTINE
;
       LXI     B,NEWNAM
       PUSH    B        ;PUSH ADDRESS OF NEW NAME
       LXI     B,OLDNAM
       PUSH    B        ;PUSH ADDRESS OF CURRENT NAME
       LHLD    DCBADR
       PUSH    H        ;PUSH ADDRESS OF DCB
       MVI     M,0      ;INDICATE
       LXI     B,DKÅBN  ;  FILE
       DAD     B        ;    CLOSED
       MVI     M,0
 
;
;RENAME!
;
       CALL    RENAM
 
;
;SET IORESULT
;
       STA     IORSLT
 
;
;RELEASE DCB AREA FROM HEAP
;
       LHLD    DCBADR  ;HL->TOP OF HEAP BEFORE RESERVATION
       SHLD    NP      ;STORE IT AS THE NEW TOP OF HEAP
       
       RET
 
       SKIP
;********** LOCAL DATA *********************
 
DCBADR:DS      2       ;ADDRESS OF DATA CONTROL BLOCK FOR FILE
OLDNAM:DS      8       ;CURRENT FILE NAME
NEWNAM:DS      8       ;NEW FILE NAME
OLDPTR:DS      2       ;ADDRESS OF OLDNAME PARAMETER
NEWPTR:DS      2       ;ADDRESS OF NEWNAME PARAMETER
 
       END