Core:EXTLINUX: applies the path from hpa to EXTLINUX
[profile/ivi/syslinux.git] / core / diskstart.inc
1 ; -----------------------------------------------------------------------
2 ;
3 ;   Copyright 1994-2009 H. Peter Anvin - All Rights Reserved
4 ;   Copyright 2009 Intel Corporation; author: H. Peter Anvin
5 ;
6 ;   This program is free software; you can redistribute it and/or modify
7 ;   it under the terms of the GNU General Public License as published by
8 ;   the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
9 ;   Boston MA 02110-1301, USA; either version 2 of the License, or
10 ;   (at your option) any later version; incorporated herein by reference.
11 ;
12 ; -----------------------------------------------------------------------
13
14 ;
15 ; diskstart.inc
16 ;
17 ; Common early-bootstrap code for harddisk-based Syslinux derivatives.
18 ;
19
20                 ; Expanded superblock
21                 section .earlybss
22                 alignb 8
23 SuperInfo       resq 16                 ; The first 16 bytes expanded 8 times
24 DriveNumber     resb 1
25
26                 section .init
27 ;
28 ; Some of the things that have to be saved very early are saved
29 ; "close" to the initial stack pointer offset, in order to
30 ; reduce the code size...
31 ;
32 StackBuf        equ $-44-32             ; Start the stack here (grow down - 4K)
33 PartInfo        equ StackBuf            ; Saved partition table entry
34 FloppyTable     equ PartInfo+16         ; Floppy info table (must follow PartInfo)
35 OrigFDCTabPtr   equ StackBuf-8          ; The 2nd high dword on the stack
36 OrigESDI        equ StackBuf-4          ; The high dword on the stack
37 StackTop        equ OrigFDCTabPtr       ; The start of the canonical stack
38
39 ;
40 ; Primary entry point.  Tempting as though it may be, we can't put the
41 ; initial "cli" here; the jmp opcode in the first byte is part of the
42 ; "magic number" (using the term very loosely) for the DOS superblock.
43 ;
44 bootsec         equ $
45 _start:         jmp short start         ; 2 bytes
46                 nop                     ; 1 byte
47 ;
48 ; "Superblock" follows -- it's in the boot sector, so it's already
49 ; loaded and ready for us
50 ;
51 bsOemName       db MY_NAME              ; The SYS command sets this, so...
52                 zb 8-($-bsOemName)
53
54 ;
55 ; These are the fields we actually care about.  We end up expanding them
56 ; all to dword size early in the code, so generate labels for both
57 ; the expanded and unexpanded versions.
58 ;
59 %macro          superb 1
60 bx %+ %1        equ SuperInfo+($-superblock)*8+4
61 bs %+ %1        equ $
62                 zb 1
63 %endmacro
64 %macro          superw 1
65 bx %+ %1        equ SuperInfo+($-superblock)*8
66 bs %+ %1        equ $
67                 zw 1
68 %endmacro
69 %macro          superd 1
70 bx %+ %1        equ $                   ; no expansion for dwords
71 bs %+ %1        equ $
72                 zd 1
73 %endmacro
74 superblock      equ $
75                 superw BytesPerSec
76                 superb SecPerClust
77                 superw ResSectors
78                 superb FATs
79                 superw RootDirEnts
80                 superw Sectors
81                 superb Media
82                 superw FATsecs
83                 superw SecPerTrack
84                 superw Heads
85 superinfo_size  equ ($-superblock)-1    ; How much to expand
86                 superd Hidden
87                 superd HugeSectors
88                 ;
89                 ; This is as far as FAT12/16 and FAT32 are consistent
90                 ;
91                 ; FAT12/16 need 26 more bytes,
92                 ; FAT32 need 54 more bytes
93                 ;
94 superblock_len_fat16    equ $-superblock+26
95 superblock_len_fat32    equ $-superblock+54
96                 zb 54                   ; Maximum needed size
97 superblock_max  equ $-superblock
98
99                 global SecPerClust
100 SecPerClust     equ bxSecPerClust
101 ;
102 ; Note we don't check the constraints above now; we did that at install
103 ; time (we hope!)
104 ;
105 start:
106                 cli                     ; No interrupts yet, please
107                 cld                     ; Copy upwards
108 ;
109 ; Set up the stack
110 ;
111                 xor ax,ax
112                 mov ss,ax
113                 mov sp,StackBuf         ; Just below BSS
114                 push es                 ; Save initial ES:DI -> $PnP pointer
115                 push di
116                 mov es,ax
117 ;
118 ; DS:SI may contain a partition table entry.  Preserve it for us.
119 ;
120                 mov cx,8                ; Save partition info
121                 mov di,PartInfo
122                 rep movsw
123
124                 mov ds,ax               ; Now we can initialize DS...
125
126 ;
127 ; Now sautee the BIOS floppy info block to that it will support decent-
128 ; size transfers; the floppy block is 11 bytes and is stored in the
129 ; INT 1Eh vector (brilliant waste of resources, eh?)
130 ;
131 ; Of course, if BIOSes had been properly programmed, we wouldn't have
132 ; had to waste precious space with this code.
133 ;
134                 mov bx,fdctab
135                 lfs si,[bx]             ; FS:SI -> original fdctab
136                 push fs                 ; Save on stack in case we need to bail
137                 push si
138
139                 ; Save the old fdctab even if hard disk so the stack layout
140                 ; is the same.  The instructions above do not change the flags
141                 mov [DriveNumber],dl    ; Save drive number in DL
142                 and dl,dl               ; If floppy disk (00-7F), assume no
143                                         ; partition table
144                 js harddisk
145
146 floppy:
147                 mov cl,6                ; 12 bytes (CX == 0)
148                 ; es:di -> FloppyTable already
149                 ; This should be safe to do now, interrupts are off...
150                 mov [bx],di             ; FloppyTable
151                 mov [bx+2],ax           ; Segment 0
152                 fs rep movsw            ; Faster to move words
153                 mov cl,[bsSecPerTrack]  ; Patch the sector count
154                 mov [di-8],cl
155                 ; AX == 0 here
156                 int 13h                 ; Some BIOSes need this
157
158                 jmp short not_harddisk
159 ;
160 ; The drive number and possibly partition information was passed to us
161 ; by the BIOS or previous boot loader (MBR).  Current "best practice" is to
162 ; trust that rather than what the superblock contains.
163 ;
164 ; Would it be better to zero out bsHidden if we don't have a partition table?
165 ;
166 ; Note: di points to beyond the end of PartInfo
167 ;
168 harddisk:
169                 test byte [di-16],7Fh   ; Sanity check: "active flag" should
170                 jnz no_partition        ; be 00 or 80
171                 mov eax,[di-8]          ; Partition offset (dword)
172                 mov [bsHidden],eax
173 no_partition:
174 ;
175 ; Get disk drive parameters (don't trust the superblock.)  Don't do this for
176 ; floppy drives -- INT 13:08 on floppy drives will (may?) return info about
177 ; what the *drive* supports, not about the *media*.  Fortunately floppy disks
178 ; tend to have a fixed, well-defined geometry which is stored in the superblock.
179 ;
180                 ; DL == drive # still
181                 mov ah,08h
182                 int 13h
183                 jc no_driveparm
184                 and ah,ah
185                 jnz no_driveparm
186                 shr dx,8
187                 inc dx                  ; Contains # of heads - 1
188                 mov [bsHeads],dx
189                 and cx,3fh
190                 mov [bsSecPerTrack],cx
191 no_driveparm:
192 not_harddisk:
193 ;
194 ; Ready to enable interrupts, captain
195 ;
196                 sti
197
198 ;
199 ; Do we have EBIOS (EDD)?
200 ;
201 eddcheck:
202                 mov bx,55AAh
203                 mov ah,41h              ; EDD existence query
204                 mov dl,[DriveNumber]
205                 int 13h
206                 jc .noedd
207                 cmp bx,0AA55h
208                 jne .noedd
209                 test cl,1               ; Extended disk access functionality set
210                 jz .noedd
211                 ;
212                 ; We have EDD support...
213                 ;
214                 mov byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
215 .noedd:
216
217 ;
218 ; Load the first sector of LDLINUX.SYS; this used to be all proper
219 ; with parsing the superblock and root directory; it doesn't fit
220 ; together with EBIOS support, unfortunately.
221 ;
222                 mov eax,[FirstSector]   ; Sector start
223                 mov bx,ldlinux_sys      ; Where to load it
224                 call getonesec
225
226                 ; Some modicum of integrity checking
227                 cmp dword [ldlinux_magic+4],LDLINUX_MAGIC^HEXDATE
228                 jne kaboom
229
230                 ; Go for it...
231                 jmp ldlinux_ent
232
233 ;
234 ; getonesec: get one disk sector
235 ;
236 getonesec:
237                 mov bp,1                ; One sector
238                 ; Fall through
239
240 ;
241 ; getlinsec: load a sequence of BP floppy sector given by the linear sector
242 ;            number in EAX into the buffer at ES:BX.  We try to optimize
243 ;            by loading up to a whole track at a time, but the user
244 ;            is responsible for not crossing a 64K boundary.
245 ;            (Yes, BP is weird for a count, but it was available...)
246 ;
247 ;            On return, BX points to the first byte after the transferred
248 ;            block.
249 ;
250 ;            This routine assumes CS == DS, and trashes most registers.
251 ;
252 ; Stylistic note: use "xchg" instead of "mov" when the source is a register
253 ; that is dead from that point; this saves space.  However, please keep
254 ; the order to dst,src to keep things sane.
255 ;
256                 global getlinsec
257 getlinsec:
258                 add eax,[bsHidden]              ; Add partition offset
259                 xor edx,edx                     ; Zero-extend LBA (eventually allow 64 bits)
260
261 .jmp:           jmp strict short getlinsec_cbios
262
263 ;
264 ; getlinsec_ebios:
265 ;
266 ; getlinsec implementation for EBIOS (EDD)
267 ;
268 getlinsec_ebios:
269 .loop:
270                 push bp                         ; Sectors left
271 .retry2:
272                 call maxtrans                   ; Enforce maximum transfer size
273                 movzx edi,bp                    ; Sectors we are about to read
274                 mov cx,retry_count
275 .retry:
276
277                 ; Form DAPA on stack
278                 push edx
279                 push eax
280                 push es
281                 push bx
282                 push di
283                 push word 16
284                 mov si,sp
285                 pushad
286                 mov dl,[DriveNumber]
287                 push ds
288                 push ss
289                 pop ds                          ; DS <- SS
290                 mov ah,42h                      ; Extended Read
291                 int 13h
292                 pop ds
293                 popad
294                 lea sp,[si+16]                  ; Remove DAPA
295                 jc .error
296                 pop bp
297                 add eax,edi                     ; Advance sector pointer
298                 sub bp,di                       ; Sectors left
299                 shl di,SECTOR_SHIFT             ; 512-byte sectors
300                 add bx,di                       ; Advance buffer pointer
301                 and bp,bp
302                 jnz .loop
303
304                 ret
305
306 .error:
307                 ; Some systems seem to get "stuck" in an error state when
308                 ; using EBIOS.  Doesn't happen when using CBIOS, which is
309                 ; good, since some other systems get timeout failures
310                 ; waiting for the floppy disk to spin up.
311
312                 pushad                          ; Try resetting the device
313                 xor ax,ax
314                 mov dl,[DriveNumber]
315                 int 13h
316                 popad
317                 loop .retry                     ; CX-- and jump if not zero
318
319                 ;shr word [MaxTransfer],1       ; Reduce the transfer size
320                 ;jnz .retry2
321
322                 ; Total failure.  Try falling back to CBIOS.
323                 mov byte [getlinsec.jmp+1],(getlinsec_cbios-(getlinsec.jmp+2))
324                 ;mov byte [MaxTransfer],63      ; Max possibe CBIOS transfer
325
326                 pop bp
327                 ; ... fall through ...
328
329 ;
330 ; getlinsec_cbios:
331 ;
332 ; getlinsec implementation for legacy CBIOS
333 ;
334 getlinsec_cbios:
335 .loop:
336                 push edx
337                 push eax
338                 push bp
339                 push bx
340
341                 movzx esi,word [bsSecPerTrack]
342                 movzx edi,word [bsHeads]
343                 ;
344                 ; Dividing by sectors to get (track,sector): we may have
345                 ; up to 2^18 tracks, so we need to use 32-bit arithmetric.
346                 ;
347                 div esi
348                 xor cx,cx
349                 xchg cx,dx              ; CX <- sector index (0-based)
350                                         ; EDX <- 0
351                 ; eax = track #
352                 div edi                 ; Convert track to head/cyl
353
354                 ; We should test this, but it doesn't fit...
355                 ; cmp eax,1023
356                 ; ja .error
357
358                 ;
359                 ; Now we have AX = cyl, DX = head, CX = sector (0-based),
360                 ; BP = sectors to transfer, SI = bsSecPerTrack,
361                 ; ES:BX = data target
362                 ;
363
364                 call maxtrans                   ; Enforce maximum transfer size
365
366                 ; Must not cross track boundaries, so BP <= SI-CX
367                 sub si,cx
368                 cmp bp,si
369                 jna .bp_ok
370                 mov bp,si
371 .bp_ok:
372
373                 shl ah,6                ; Because IBM was STOOPID
374                                         ; and thought 8 bits were enough
375                                         ; then thought 10 bits were enough...
376                 inc cx                  ; Sector numbers are 1-based, sigh
377                 or cl,ah
378                 mov ch,al
379                 mov dh,dl
380                 mov dl,[DriveNumber]
381                 xchg ax,bp              ; Sector to transfer count
382                 mov ah,02h              ; Read sectors
383                 mov bp,retry_count
384 .retry:
385                 pushad
386                 int 13h
387                 popad
388                 jc .error
389 .resume:
390                 movzx ecx,al            ; ECX <- sectors transferred
391                 shl ax,SECTOR_SHIFT     ; Convert sectors in AL to bytes in AX
392                 pop bx
393                 add bx,ax
394                 pop bp
395                 pop eax
396                 pop edx
397                 add eax,ecx
398                 sub bp,cx
399                 jnz .loop
400                 ret
401
402 .error:
403                 dec bp
404                 jnz .retry
405
406                 xchg ax,bp              ; Sectors transferred <- 0
407                 shr word [MaxTransfer],1
408                 jnz .resume
409                 ; Fall through to disk_error
410
411 ;
412 ; kaboom: write a message and bail out.
413 ;
414 disk_error:
415 kaboom:
416                 xor si,si
417                 mov ss,si
418                 mov sp,OrigFDCTabPtr    ; Reset stack
419                 mov ds,si               ; Reset data segment
420                 pop dword [fdctab]      ; Restore FDC table
421 .patch:                                 ; When we have full code, intercept here
422                 mov si,bailmsg
423
424                 ; Write error message, this assumes screen page 0
425 .loop:          lodsb
426                 and al,al
427                 jz .done
428                 mov ah,0Eh              ; Write to screen as TTY
429                 mov bx,0007h            ; Attribute
430                 int 10h
431                 jmp short .loop
432 .done:
433                 cbw                     ; AH <- 0
434 .again:         int 16h                 ; Wait for keypress
435                                         ; NB: replaced by int 18h if
436                                         ; chosen at install time..
437                 int 19h                 ; And try once more to boot...
438 .norge:         jmp short .norge        ; If int 19h returned; this is the end
439
440 ;
441 ; Truncate BP to MaxTransfer
442 ;
443 maxtrans:
444                 cmp bp,[MaxTransfer]
445                 jna .ok
446                 mov bp,[MaxTransfer]
447 .ok:            ret
448
449 ;
450 ; Error message on failure
451 ;
452 bailmsg:        db 'Boot error', 0Dh, 0Ah, 0
453
454                 ; This fails if the boot sector overflows
455                 zb 1F8h-($-$$)
456
457 FirstSector     dd 0xDEADBEEF                   ; Location of sector 1
458                 global MaxTransfer
459 MaxTransfer     dw 0x007F                       ; Max transfer size
460
461 ; This field will be filled in 0xAA55 by the installer, but we abuse it
462 ; to house a pointer to the INT 16h instruction at
463 ; kaboom.again, which gets patched to INT 18h in RAID mode.
464 bootsignature   dw kaboom.again-bootsec
465
466 ;
467 ; ===========================================================================
468 ;  End of boot sector
469 ; ===========================================================================
470 ;  Start of LDLINUX.SYS
471 ; ===========================================================================
472
473 ldlinux_sys:
474
475 syslinux_banner db 0Dh, 0Ah
476                 db MY_NAME, ' ', VERSION_STR, ' ', DATE_STR, ' ', 0
477                 db 0Dh, 0Ah, 1Ah        ; EOF if we "type" this in DOS
478
479                 alignz 8
480 ldlinux_magic   dd LDLINUX_MAGIC
481                 dd LDLINUX_MAGIC^HEXDATE
482
483 ;
484 ; This area is patched by the installer.  It is found by looking for
485 ; LDLINUX_MAGIC, plus 8 bytes.
486 ;
487 patch_area:
488 DataSectors     dw 0            ; Number of sectors (not including bootsec)
489 ADVSectors      dw 0            ; Additional sectors for ADVs
490 LDLDwords       dd 0            ; Total dwords starting at ldlinux_sys,
491 CheckSum        dd 0            ; Checksum starting at ldlinux_sys
492                                 ; value = LDLINUX_MAGIC - [sum of dwords]
493                 global CurrentDir
494 CurrentDir      dd 2            ; "Current" directory inode number (EXTLINUX)
495 SecPtrOffset    dw SectorPtrs - ldlinux_sys
496 SecPtrCnt       dw (SectorPtrsEnd - SectorPtrs) >> 2
497
498 ldlinux_ent:
499 ;
500 ; Note that some BIOSes are buggy and run the boot sector at 07C0:0000
501 ; instead of 0000:7C00 and the like.  We don't want to add anything
502 ; more to the boot sector, so it is written to not assume a fixed
503 ; value in CS, but we don't want to deal with that anymore from now
504 ; on.
505 ;
506                 jmp 0:.next
507 .next:
508
509 ;
510 ; Tell the user we got this far
511 ;
512                 mov si,syslinux_banner
513                 call writestr_early
514
515 ;
516 ; Tell the user if we're using EBIOS or CBIOS
517 ;
518 print_bios:
519                 mov si,cbios_name
520                 cmp byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
521                 jne .cbios
522                 mov si,ebios_name
523 .cbios:
524                 mov [BIOSName],si
525                 call writestr_early
526
527                 section .earlybss
528 %define HAVE_BIOSNAME 1
529 BIOSName        resw 1
530
531                 section .init
532 ;
533 ; Now we read the rest of LDLINUX.SYS.  Don't bother loading the first
534 ; sector again, though.
535 ;
536 load_rest:
537                 lea esi,[SectorPtrs]
538                 mov ebx,7C00h+2*SECTOR_SIZE     ; Where we start loading
539                 mov cx,[DataSectors]
540                 dec cx                          ; Minus this sector
541
542 .get_chunk:
543                 jcxz .done
544                 xor ebp,ebp
545                 mov di,bx                       ; Low 64K of target address
546                 lodsd                           ; First sector of this chunk
547
548                 mov edx,eax
549
550 .make_chunk:
551                 inc bp
552                 dec cx
553                 jz .chunk_ready
554                 cmp ebx,esi                     ; Pointer we don't have yet?
555                 jae .chunk_ready
556                 inc edx                         ; Next linear sector
557                 cmp [si],edx                    ; Does it match
558                 jnz .chunk_ready                ; If not, this is it
559                 add si,4                        ; If so, add sector to chunk
560                 add di,SECTOR_SIZE              ; Check for 64K segment wrap
561                 jnz .make_chunk
562
563 .chunk_ready:
564                 push ebx
565                 push es
566                 shr ebx,4                       ; Convert to a segment
567                 mov es,bx
568                 xor bx,bx
569                 xor edx,edx                     ; Zero-extend LBA
570                 call getlinsecsr
571                 pop es
572                 pop ebx
573                 shl ebp,SECTOR_SHIFT
574                 add ebx,ebp
575                 jmp .get_chunk
576
577 .done:
578
579 ;
580 ; All loaded up, verify that we got what we needed.
581 ; Note: the checksum field is embedded in the checksum region, so
582 ; by the time we get to the end it should all cancel out.
583 ;
584 verify_checksum:
585                 mov si,ldlinux_sys
586                 mov ecx,[LDLDwords]
587                 mov eax,-LDLINUX_MAGIC
588                 push ds
589 .checksum:
590                 add eax,[si]
591                 add si,4
592                 jnz .nowrap
593                 ; Handle segment wrap
594                 mov dx,ds
595                 add dx,1000h
596                 mov ds,dx
597 .nowrap:
598                 dec ecx
599                 jnz .checksum
600                 pop ds
601
602                 and eax,eax                     ; Should be zero
603                 jz all_read                     ; We're cool, go for it!
604
605 ;
606 ; Uh-oh, something went bad...
607 ;
608                 mov si,checksumerr_msg
609                 call writestr_early
610                 jmp kaboom
611
612 ;
613 ; -----------------------------------------------------------------------------
614 ; Subroutines that have to be in the first sector
615 ; -----------------------------------------------------------------------------
616
617 ;
618 ;
619 ; writestr_early: write a null-terminated string to the console
620 ;           This assumes we're on page 0.  This is only used for early
621 ;           messages, so it should be OK.
622 ;
623 writestr_early:
624                 pushad
625 .loop:          lodsb
626                 and al,al
627                 jz .return
628                 mov ah,0Eh              ; Write to screen as TTY
629                 mov bx,0007h            ; Attribute
630                 int 10h
631                 jmp short .loop
632 .return:        popad
633                 ret
634
635
636 ; getlinsecsr: save registers, call getlinsec, restore registers
637 ;
638 getlinsecsr:    pushad
639                 call getlinsec
640                 popad
641                 ret
642
643 ;
644 ; Checksum error message
645 ;
646 checksumerr_msg db ' Load error - ', 0  ; Boot failed appended
647
648 ;
649 ; BIOS type string
650 ;
651 cbios_name      db 'CBIOS', 0
652 ebios_name      db 'EBIOS', 0
653
654 ;
655 ; Debug routine
656 ;
657 %ifdef debug
658 safedumpregs:
659                 cmp word [Debug_Magic],0D00Dh
660                 jnz nc_return
661                 jmp dumpregs
662 %endif
663
664 rl_checkpt      equ $                           ; Must be <= 8000h
665
666 rl_checkpt_off  equ ($-$$)
667 %ifndef DEPEND
668 %if rl_checkpt_off > 3FCh                       ; Need one pointer in here
669 %error "Sector 1 overflow"
670 %endif
671 %endif
672
673 ; Sector pointers
674                 alignz 4
675 MaxInitDataSize equ 96 << 10
676 MaxLMA          equ 0x7c00+SECTOR_SIZE+MaxInitDataSize
677 SectorPtrs      times MaxInitDataSize >> SECTOR_SHIFT dd 0
678 SectorPtrsEnd   equ $
679
680 ; ----------------------------------------------------------------------------
681 ;  End of code and data that have to be in the first sector
682 ; ----------------------------------------------------------------------------
683
684                 section .text16
685 all_read:
686 ;
687 ; Let the user (and programmer!) know we got this far.  This used to be
688 ; in Sector 1, but makes a lot more sense here.
689 ;
690                 mov si,copyright_str
691                 call writestr_early
692
693
694 ;
695 ; Insane hack to expand the DOS superblock to dwords
696 ;
697 expand_super:
698                 xor eax,eax
699                 mov si,superblock
700                 mov di,SuperInfo
701                 mov cx,superinfo_size
702 .loop:
703                 lodsw
704                 dec si
705                 stosd                           ; Store expanded word
706                 xor ah,ah
707                 stosd                           ; Store expanded byte
708                 loop .loop
709
710
711 ;
712 ; Common initialization code
713 ;
714 %include "init.inc"
715 %include "cpuinit.inc"
716
717                 
718                 pushad
719 %if IS_PXELINUX
720               extern pxe_fs_ops
721               mov eax,pxe_fs_ops
722 %else
723  %if IS_EXTLINUX
724               extern ext2_fs_ops
725               mov eax,ext2_fs_ops
726  %elif IS_SYSLINUX
727               extern vfat_fs_ops
728               mov eax,vfat_fs_ops
729  %elif IS_ISOLINUX
730               extern iso_fs_ops
731               mov eax,iso_fs_ops
732  %endif
733               mov dl,[DriveNumber]
734                 mov dh,0               ; we are boot from disk not CDROM
735               mov ecx,[bsHidden]
736               mov ebx,[bsHidden+4]
737                 mov si,[bsHeads]
738                 mov di,[bsSecPerTrack]
739 %endif
740                 pm_call fs_init
741                 popad